From 9c195bf5d86d67ea5eb419ccf6e48dc153e57c68 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Tue, 4 Nov 2014 20:14:19 +0100 Subject: Move sources to src/ subdirectory. --- back_end.adb | 38 - back_end.ads | 57 - bug.adb | 104 - bug.ads | 26 - canon.adb | 2735 -- canon.ads | 70 - canon_psl.adb | 43 - canon_psl.ads | 26 - configuration.adb | 614 - configuration.ads | 55 - disp_tree.adb | 511 - disp_tree.ads | 27 - disp_vhdl.adb | 3247 -- disp_vhdl.ads | 38 - errorout.adb | 1113 - errorout.ads | 128 - evaluation.adb | 3047 -- evaluation.ads | 161 - files_map.adb | 857 - files_map.ads | 152 - flags.adb | 53 - flags.ads | 190 - ieee-std_logic_1164.adb | 170 - ieee-std_logic_1164.ads | 35 - ieee-vital_timing.adb | 1377 - ieee-vital_timing.ads | 41 - ieee.ads | 5 - iir_chain_handling.adb | 68 - iir_chain_handling.ads | 47 - iir_chains.adb | 64 - iir_chains.ads | 113 - iirs.adb | 4515 --- iirs.adb.in | 229 - iirs.ads | 6445 ---- iirs_utils.adb | 1131 - iirs_utils.ads | 250 - iirs_walk.adb | 115 - iirs_walk.ads | 45 - libraries.adb | 1714 - libraries.ads | 188 - lists.adb | 257 - lists.ads | 123 - name_table.adb | 359 - name_table.ads | 98 - nodes.adb | 467 - nodes.ads | 335 - nodes_gc.adb | 206 - nodes_gc.adb.in | 159 - nodes_gc.ads | 24 - nodes_meta.adb | 9409 ------ nodes_meta.adb.in | 76 - nodes_meta.ads | 823 - nodes_meta.ads.in | 66 - options.adb | 242 - options.ads | 30 - ortho/Makefile.inc | 38 - ortho/debug/Makefile | 47 - ortho/debug/ortho_debug-disp.adb | 1064 - ortho/debug/ortho_debug-disp.ads | 29 - ortho/debug/ortho_debug-main.adb | 151 - ortho/debug/ortho_debug.adb | 1931 -- ortho/debug/ortho_debug.private.ads | 467 - ortho/debug/ortho_debug_front.ads | 20 - ortho/debug/ortho_ident.ads | 20 - ortho/debug/ortho_ident_hash.adb | 72 - ortho/debug/ortho_ident_hash.ads | 46 - ortho/debug/ortho_ident_simple.adb | 44 - ortho/debug/ortho_ident_simple.ads | 31 - ortho/debug/ortho_nodes.ads | 21 - ortho/gcc/Makefile | 86 - ortho/gcc/Makefile.conf.linux | 4 - ortho/gcc/lang.opt | 96 - ortho/gcc/ortho-lang.c | 2191 -- ortho/gcc/ortho_gcc-main.adb | 42 - ortho/gcc/ortho_gcc-main.ads | 1 - ortho/gcc/ortho_gcc.adb | 121 - ortho/gcc/ortho_gcc.ads | 701 - ortho/gcc/ortho_gcc.private.ads | 269 - ortho/gcc/ortho_gcc_front.ads | 2 - ortho/gcc/ortho_ident.adb | 56 - ortho/gcc/ortho_ident.ads | 30 - ortho/gcc/ortho_nodes.ads | 3 - ortho/llvm/Makefile | 30 - ortho/llvm/llvm-analysis.ads | 53 - ortho/llvm/llvm-bitwriter.ads | 34 - ortho/llvm/llvm-cbindings.cpp | 61 - ortho/llvm/llvm-core.ads | 1279 - ortho/llvm/llvm-executionengine.ads | 163 - ortho/llvm/llvm-target.ads | 84 - ortho/llvm/llvm-targetmachine.ads | 122 - ortho/llvm/llvm-transforms-scalar.ads | 169 - ortho/llvm/llvm-transforms.ads | 21 - ortho/llvm/llvm.ads | 21 - ortho/llvm/ortho_code_main.adb | 391 - ortho/llvm/ortho_ident.adb | 134 - ortho/llvm/ortho_ident.ads | 42 - ortho/llvm/ortho_jit.adb | 151 - ortho/llvm/ortho_llvm-jit.adb | 55 - ortho/llvm/ortho_llvm-jit.ads | 31 - ortho/llvm/ortho_llvm.adb | 2881 -- ortho/llvm/ortho_llvm.ads | 737 - ortho/llvm/ortho_llvm.private.ads | 305 - ortho/llvm/ortho_nodes.ads | 20 - ortho/mcode/Makefile | 37 - ortho/mcode/binary_file-coff.adb | 407 - ortho/mcode/binary_file-coff.ads | 23 - ortho/mcode/binary_file-elf.adb | 679 - ortho/mcode/binary_file-elf.ads | 22 - ortho/mcode/binary_file-memory.adb | 101 - ortho/mcode/binary_file-memory.ads | 25 - ortho/mcode/binary_file.adb | 977 - ortho/mcode/binary_file.ads | 305 - ortho/mcode/coff.ads | 208 - ortho/mcode/coffdump.adb | 274 - ortho/mcode/disa_sparc.adb | 274 - ortho/mcode/disa_sparc.ads | 15 - ortho/mcode/disa_x86.adb | 997 - ortho/mcode/disa_x86.ads | 34 - ortho/mcode/disassemble.ads | 3 - ortho/mcode/dwarf.ads | 446 - ortho/mcode/elf32.adb | 48 - ortho/mcode/elf32.ads | 124 - ortho/mcode/elf64.ads | 105 - ortho/mcode/elf_arch.ads | 2 - ortho/mcode/elf_arch32.ads | 37 - ortho/mcode/elf_arch64.ads | 37 - ortho/mcode/elf_common.adb | 48 - ortho/mcode/elf_common.ads | 250 - ortho/mcode/elfdump.adb | 267 - ortho/mcode/elfdumper.adb | 2818 -- ortho/mcode/elfdumper.ads | 164 - ortho/mcode/hex_images.adb | 71 - ortho/mcode/hex_images.ads | 26 - ortho/mcode/memsegs.ads | 3 - ortho/mcode/memsegs_c.c | 133 - ortho/mcode/memsegs_mmap.adb | 64 - ortho/mcode/memsegs_mmap.ads | 49 - ortho/mcode/ortho_code-abi.ads | 3 - ortho/mcode/ortho_code-binary.adb | 37 - ortho/mcode/ortho_code-binary.ads | 31 - ortho/mcode/ortho_code-consts.adb | 559 - ortho/mcode/ortho_code-consts.ads | 158 - ortho/mcode/ortho_code-debug.adb | 143 - ortho/mcode/ortho_code-debug.ads | 70 - ortho/mcode/ortho_code-decls.adb | 783 - ortho/mcode/ortho_code-decls.ads | 209 - ortho/mcode/ortho_code-disps.adb | 790 - ortho/mcode/ortho_code-disps.ads | 25 - ortho/mcode/ortho_code-dwarf.adb | 1351 - ortho/mcode/ortho_code-dwarf.ads | 41 - ortho/mcode/ortho_code-exprs.adb | 1663 - ortho/mcode/ortho_code-exprs.ads | 600 - ortho/mcode/ortho_code-flags.ads | 35 - ortho/mcode/ortho_code-opts.adb | 214 - ortho/mcode/ortho_code-opts.ads | 22 - ortho/mcode/ortho_code-types.adb | 820 - ortho/mcode/ortho_code-types.ads | 240 - ortho/mcode/ortho_code-x86-abi.adb | 762 - ortho/mcode/ortho_code-x86-abi.ads | 76 - ortho/mcode/ortho_code-x86-emits.adb | 2322 -- ortho/mcode/ortho_code-x86-emits.ads | 36 - ortho/mcode/ortho_code-x86-flags_linux.ads | 31 - ortho/mcode/ortho_code-x86-flags_macosx.ads | 31 - ortho/mcode/ortho_code-x86-flags_windows.ads | 31 - ortho/mcode/ortho_code-x86-insns.adb | 2068 -- ortho/mcode/ortho_code-x86-insns.ads | 25 - ortho/mcode/ortho_code-x86.adb | 109 - ortho/mcode/ortho_code-x86.ads | 160 - ortho/mcode/ortho_code.ads | 150 - ortho/mcode/ortho_code_main.adb | 198 - ortho/mcode/ortho_ident.adb | 117 - ortho/mcode/ortho_ident.ads | 38 - ortho/mcode/ortho_jit.adb | 125 - ortho/mcode/ortho_mcode-jit.adb | 28 - ortho/mcode/ortho_mcode-jit.ads | 9 - ortho/mcode/ortho_mcode.adb | 738 - ortho/mcode/ortho_mcode.ads | 583 - ortho/mcode/ortho_mcode.private.ads | 151 - ortho/mcode/ortho_nodes.ads | 2 - ortho/oread/Makefile | 43 - ortho/oread/ortho_front.adb | 2677 -- ortho/ortho_front.ads | 41 - ortho/ortho_jit.ads | 43 - ortho/ortho_nodes.common.ads | 453 - parse.adb | 7143 ----- parse.ads | 44 - parse_psl.adb | 667 - parse_psl.ads | 26 - post_sems.adb | 71 - post_sems.ads | 25 - psl-errors.ads | 3 - psl/psl-build.adb | 1009 - psl/psl-build.ads | 7 - psl/psl-cse.adb | 201 - psl/psl-cse.ads | 10 - psl/psl-disp_nfas.adb | 111 - psl/psl-disp_nfas.ads | 12 - psl/psl-dump_tree.adb | 867 - psl/psl-dump_tree.ads | 9 - psl/psl-hash.adb | 60 - psl/psl-hash.ads | 11 - psl/psl-nfas-utils.adb | 330 - psl/psl-nfas-utils.ads | 21 - psl/psl-nfas.adb | 529 - psl/psl-nfas.ads | 108 - psl/psl-nodes.adb | 1231 - psl/psl-nodes.ads | 563 - psl/psl-optimize.adb | 460 - psl/psl-optimize.ads | 24 - psl/psl-prints.adb | 433 - psl/psl-prints.ads | 20 - psl/psl-priorities.ads | 63 - psl/psl-qm.adb | 318 - psl/psl-qm.ads | 49 - psl/psl-rewrites.adb | 604 - psl/psl-rewrites.ads | 7 - psl/psl-subsets.adb | 177 - psl/psl-subsets.ads | 23 - psl/psl-tprint.adb | 255 - psl/psl-tprint.ads | 6 - psl/psl.ads | 3 - scanner-scan_literal.adb | 651 - scanner.adb | 1621 - scanner.ads | 120 - sem.adb | 2749 -- sem.ads | 82 - sem_assocs.adb | 1903 -- sem_assocs.ads | 60 - sem_decls.adb | 3018 -- sem_decls.ads | 52 - sem_expr.adb | 4262 --- sem_expr.ads | 178 - sem_inst.adb | 639 - sem_inst.ads | 26 - sem_names.adb | 3788 --- sem_names.ads | 159 - sem_psl.adb | 617 - sem_psl.ads | 26 - sem_scopes.adb | 1412 - sem_scopes.ads | 217 - sem_specs.adb | 1731 - sem_specs.ads | 88 - sem_stmts.adb | 2007 -- sem_stmts.ads | 87 - sem_types.adb | 2210 -- sem_types.ads | 57 - simulate/annotations.adb | 1236 - simulate/annotations.ads | 120 - simulate/areapools.adb | 147 - simulate/areapools.ads | 87 - simulate/debugger.adb | 1845 -- simulate/debugger.ads | 90 - simulate/elaboration.adb | 2582 -- simulate/elaboration.ads | 209 - simulate/execution.adb | 4837 --- simulate/execution.ads | 185 - simulate/file_operation.adb | 341 - simulate/file_operation.ads | 81 - simulate/grt_interface.adb | 44 - simulate/grt_interface.ads | 27 - simulate/iir_values.adb | 1066 - simulate/iir_values.ads | 355 - simulate/sim_be.adb | 117 - simulate/sim_be.ads | 25 - simulate/simulation-ams-debugger.adb | 87 - simulate/simulation-ams-debugger.ads | 27 - simulate/simulation-ams.adb | 201 - simulate/simulation-ams.ads | 165 - simulate/simulation.adb | 1669 - simulate/simulation.ads | 128 - src/back_end.adb | 38 + src/back_end.ads | 57 + src/bug.adb | 104 + src/bug.ads | 26 + src/canon.adb | 2735 ++ src/canon.ads | 70 + src/canon_psl.adb | 43 + src/canon_psl.ads | 26 + src/configuration.adb | 614 + src/configuration.ads | 55 + src/disp_tree.adb | 511 + src/disp_tree.ads | 27 + src/disp_vhdl.adb | 3247 ++ src/disp_vhdl.ads | 38 + src/errorout.adb | 1113 + src/errorout.ads | 128 + src/evaluation.adb | 3047 ++ src/evaluation.ads | 161 + src/files_map.adb | 857 + src/files_map.ads | 152 + src/flags.adb | 53 + src/flags.ads | 190 + src/ieee-std_logic_1164.adb | 170 + src/ieee-std_logic_1164.ads | 35 + src/ieee-vital_timing.adb | 1377 + src/ieee-vital_timing.ads | 41 + src/ieee.ads | 5 + src/iir_chain_handling.adb | 68 + src/iir_chain_handling.ads | 47 + src/iir_chains.adb | 64 + src/iir_chains.ads | 113 + src/iirs.adb | 4515 +++ src/iirs.adb.in | 229 + src/iirs.ads | 6445 ++++ src/iirs_utils.adb | 1131 + src/iirs_utils.ads | 250 + src/iirs_walk.adb | 115 + src/iirs_walk.ads | 45 + src/libraries.adb | 1714 + src/libraries.ads | 188 + src/lists.adb | 257 + src/lists.ads | 123 + src/name_table.adb | 359 + src/name_table.ads | 98 + src/nodes.adb | 467 + src/nodes.ads | 335 + src/nodes_gc.adb | 206 + src/nodes_gc.adb.in | 159 + src/nodes_gc.ads | 24 + src/nodes_meta.adb | 9409 ++++++ src/nodes_meta.adb.in | 76 + src/nodes_meta.ads | 823 + src/nodes_meta.ads.in | 66 + src/options.adb | 242 + src/options.ads | 30 + src/ortho/Makefile.inc | 38 + src/ortho/debug/Makefile | 47 + src/ortho/debug/ortho_debug-disp.adb | 1064 + src/ortho/debug/ortho_debug-disp.ads | 29 + src/ortho/debug/ortho_debug-main.adb | 151 + src/ortho/debug/ortho_debug.adb | 1931 ++ src/ortho/debug/ortho_debug.private.ads | 467 + src/ortho/debug/ortho_debug_front.ads | 20 + src/ortho/debug/ortho_ident.ads | 20 + src/ortho/debug/ortho_ident_hash.adb | 72 + src/ortho/debug/ortho_ident_hash.ads | 46 + src/ortho/debug/ortho_ident_simple.adb | 44 + src/ortho/debug/ortho_ident_simple.ads | 31 + src/ortho/debug/ortho_nodes.ads | 21 + src/ortho/gcc/Makefile | 86 + src/ortho/gcc/Makefile.conf.linux | 4 + src/ortho/gcc/lang.opt | 96 + src/ortho/gcc/ortho-lang.c | 2191 ++ src/ortho/gcc/ortho_gcc-main.adb | 42 + src/ortho/gcc/ortho_gcc-main.ads | 1 + src/ortho/gcc/ortho_gcc.adb | 121 + src/ortho/gcc/ortho_gcc.ads | 701 + src/ortho/gcc/ortho_gcc.private.ads | 269 + src/ortho/gcc/ortho_gcc_front.ads | 2 + src/ortho/gcc/ortho_ident.adb | 56 + src/ortho/gcc/ortho_ident.ads | 30 + src/ortho/gcc/ortho_nodes.ads | 3 + src/ortho/llvm/Makefile | 30 + src/ortho/llvm/llvm-analysis.ads | 53 + src/ortho/llvm/llvm-bitwriter.ads | 34 + src/ortho/llvm/llvm-cbindings.cpp | 61 + src/ortho/llvm/llvm-core.ads | 1279 + src/ortho/llvm/llvm-executionengine.ads | 163 + src/ortho/llvm/llvm-target.ads | 84 + src/ortho/llvm/llvm-targetmachine.ads | 122 + src/ortho/llvm/llvm-transforms-scalar.ads | 169 + src/ortho/llvm/llvm-transforms.ads | 21 + src/ortho/llvm/llvm.ads | 21 + src/ortho/llvm/ortho_code_main.adb | 391 + src/ortho/llvm/ortho_ident.adb | 134 + src/ortho/llvm/ortho_ident.ads | 42 + src/ortho/llvm/ortho_jit.adb | 151 + src/ortho/llvm/ortho_llvm-jit.adb | 55 + src/ortho/llvm/ortho_llvm-jit.ads | 31 + src/ortho/llvm/ortho_llvm.adb | 2881 ++ src/ortho/llvm/ortho_llvm.ads | 737 + src/ortho/llvm/ortho_llvm.private.ads | 305 + src/ortho/llvm/ortho_nodes.ads | 20 + src/ortho/mcode/Makefile | 37 + src/ortho/mcode/binary_file-coff.adb | 407 + src/ortho/mcode/binary_file-coff.ads | 23 + src/ortho/mcode/binary_file-elf.adb | 679 + src/ortho/mcode/binary_file-elf.ads | 22 + src/ortho/mcode/binary_file-memory.adb | 101 + src/ortho/mcode/binary_file-memory.ads | 25 + src/ortho/mcode/binary_file.adb | 977 + src/ortho/mcode/binary_file.ads | 305 + src/ortho/mcode/coff.ads | 208 + src/ortho/mcode/coffdump.adb | 274 + src/ortho/mcode/disa_sparc.adb | 274 + src/ortho/mcode/disa_sparc.ads | 15 + src/ortho/mcode/disa_x86.adb | 997 + src/ortho/mcode/disa_x86.ads | 34 + src/ortho/mcode/disassemble.ads | 3 + src/ortho/mcode/dwarf.ads | 446 + src/ortho/mcode/elf32.adb | 48 + src/ortho/mcode/elf32.ads | 124 + src/ortho/mcode/elf64.ads | 105 + src/ortho/mcode/elf_arch.ads | 2 + src/ortho/mcode/elf_arch32.ads | 37 + src/ortho/mcode/elf_arch64.ads | 37 + src/ortho/mcode/elf_common.adb | 48 + src/ortho/mcode/elf_common.ads | 250 + src/ortho/mcode/elfdump.adb | 267 + src/ortho/mcode/elfdumper.adb | 2818 ++ src/ortho/mcode/elfdumper.ads | 164 + src/ortho/mcode/hex_images.adb | 71 + src/ortho/mcode/hex_images.ads | 26 + src/ortho/mcode/memsegs.ads | 3 + src/ortho/mcode/memsegs_c.c | 133 + src/ortho/mcode/memsegs_mmap.adb | 64 + src/ortho/mcode/memsegs_mmap.ads | 49 + src/ortho/mcode/ortho_code-abi.ads | 3 + src/ortho/mcode/ortho_code-binary.adb | 37 + src/ortho/mcode/ortho_code-binary.ads | 31 + src/ortho/mcode/ortho_code-consts.adb | 559 + src/ortho/mcode/ortho_code-consts.ads | 158 + src/ortho/mcode/ortho_code-debug.adb | 143 + src/ortho/mcode/ortho_code-debug.ads | 70 + src/ortho/mcode/ortho_code-decls.adb | 783 + src/ortho/mcode/ortho_code-decls.ads | 209 + src/ortho/mcode/ortho_code-disps.adb | 790 + src/ortho/mcode/ortho_code-disps.ads | 25 + src/ortho/mcode/ortho_code-dwarf.adb | 1351 + src/ortho/mcode/ortho_code-dwarf.ads | 41 + src/ortho/mcode/ortho_code-exprs.adb | 1663 + src/ortho/mcode/ortho_code-exprs.ads | 600 + src/ortho/mcode/ortho_code-flags.ads | 35 + src/ortho/mcode/ortho_code-opts.adb | 214 + src/ortho/mcode/ortho_code-opts.ads | 22 + src/ortho/mcode/ortho_code-types.adb | 820 + src/ortho/mcode/ortho_code-types.ads | 240 + src/ortho/mcode/ortho_code-x86-abi.adb | 762 + src/ortho/mcode/ortho_code-x86-abi.ads | 76 + src/ortho/mcode/ortho_code-x86-emits.adb | 2322 ++ src/ortho/mcode/ortho_code-x86-emits.ads | 36 + src/ortho/mcode/ortho_code-x86-flags_linux.ads | 31 + src/ortho/mcode/ortho_code-x86-flags_macosx.ads | 31 + src/ortho/mcode/ortho_code-x86-flags_windows.ads | 31 + src/ortho/mcode/ortho_code-x86-insns.adb | 2068 ++ src/ortho/mcode/ortho_code-x86-insns.ads | 25 + src/ortho/mcode/ortho_code-x86.adb | 109 + src/ortho/mcode/ortho_code-x86.ads | 160 + src/ortho/mcode/ortho_code.ads | 150 + src/ortho/mcode/ortho_code_main.adb | 198 + src/ortho/mcode/ortho_ident.adb | 117 + src/ortho/mcode/ortho_ident.ads | 38 + src/ortho/mcode/ortho_jit.adb | 125 + src/ortho/mcode/ortho_mcode-jit.adb | 28 + src/ortho/mcode/ortho_mcode-jit.ads | 9 + src/ortho/mcode/ortho_mcode.adb | 738 + src/ortho/mcode/ortho_mcode.ads | 583 + src/ortho/mcode/ortho_mcode.private.ads | 151 + src/ortho/mcode/ortho_nodes.ads | 2 + src/ortho/oread/Makefile | 43 + src/ortho/oread/ortho_front.adb | 2677 ++ src/ortho/ortho_front.ads | 41 + src/ortho/ortho_jit.ads | 43 + src/ortho/ortho_nodes.common.ads | 453 + src/parse.adb | 7143 +++++ src/parse.ads | 44 + src/parse_psl.adb | 667 + src/parse_psl.ads | 26 + src/post_sems.adb | 71 + src/post_sems.ads | 25 + src/psl-errors.ads | 3 + src/psl/psl-build.adb | 1009 + src/psl/psl-build.ads | 7 + src/psl/psl-cse.adb | 201 + src/psl/psl-cse.ads | 10 + src/psl/psl-disp_nfas.adb | 111 + src/psl/psl-disp_nfas.ads | 12 + src/psl/psl-dump_tree.adb | 867 + src/psl/psl-dump_tree.ads | 9 + src/psl/psl-hash.adb | 60 + src/psl/psl-hash.ads | 11 + src/psl/psl-nfas-utils.adb | 330 + src/psl/psl-nfas-utils.ads | 21 + src/psl/psl-nfas.adb | 529 + src/psl/psl-nfas.ads | 108 + src/psl/psl-nodes.adb | 1231 + src/psl/psl-nodes.ads | 563 + src/psl/psl-optimize.adb | 460 + src/psl/psl-optimize.ads | 24 + src/psl/psl-prints.adb | 433 + src/psl/psl-prints.ads | 20 + src/psl/psl-priorities.ads | 63 + src/psl/psl-qm.adb | 318 + src/psl/psl-qm.ads | 49 + src/psl/psl-rewrites.adb | 604 + src/psl/psl-rewrites.ads | 7 + src/psl/psl-subsets.adb | 177 + src/psl/psl-subsets.ads | 23 + src/psl/psl-tprint.adb | 255 + src/psl/psl-tprint.ads | 6 + src/psl/psl.ads | 3 + src/scanner-scan_literal.adb | 651 + src/scanner.adb | 1621 + src/scanner.ads | 120 + src/sem.adb | 2749 ++ src/sem.ads | 82 + src/sem_assocs.adb | 1903 ++ src/sem_assocs.ads | 60 + src/sem_decls.adb | 3018 ++ src/sem_decls.ads | 52 + src/sem_expr.adb | 4262 +++ src/sem_expr.ads | 178 + src/sem_inst.adb | 639 + src/sem_inst.ads | 26 + src/sem_names.adb | 3788 +++ src/sem_names.ads | 159 + src/sem_psl.adb | 617 + src/sem_psl.ads | 26 + src/sem_scopes.adb | 1412 + src/sem_scopes.ads | 217 + src/sem_specs.adb | 1731 + src/sem_specs.ads | 88 + src/sem_stmts.adb | 2007 ++ src/sem_stmts.ads | 87 + src/sem_types.adb | 2210 ++ src/sem_types.ads | 57 + src/simulate/annotations.adb | 1236 + src/simulate/annotations.ads | 120 + src/simulate/areapools.adb | 147 + src/simulate/areapools.ads | 87 + src/simulate/debugger.adb | 1845 ++ src/simulate/debugger.ads | 90 + src/simulate/elaboration.adb | 2582 ++ src/simulate/elaboration.ads | 209 + src/simulate/execution.adb | 4837 +++ src/simulate/execution.ads | 185 + src/simulate/file_operation.adb | 341 + src/simulate/file_operation.ads | 81 + src/simulate/grt_interface.adb | 44 + src/simulate/grt_interface.ads | 27 + src/simulate/iir_values.adb | 1066 + src/simulate/iir_values.ads | 355 + src/simulate/sim_be.adb | 117 + src/simulate/sim_be.ads | 25 + src/simulate/simulation-ams-debugger.adb | 87 + src/simulate/simulation-ams-debugger.ads | 27 + src/simulate/simulation-ams.adb | 201 + src/simulate/simulation-ams.ads | 165 + src/simulate/simulation.adb | 1669 + src/simulate/simulation.ads | 128 + src/std_names.adb | 482 + src/std_names.ads | 727 + src/std_package.adb | 1200 + src/std_package.ads | 182 + src/str_table.adb | 92 + src/str_table.ads | 44 + src/tokens.adb | 443 + src/tokens.ads | 279 + src/translate/Makefile | 45 + src/translate/gcc/ANNOUNCE | 21 + src/translate/gcc/INSTALL | 24 + src/translate/gcc/Make-lang.in | 190 + src/translate/gcc/Makefile.in | 299 + src/translate/gcc/README | 87 + src/translate/gcc/config-lang.in | 38 + src/translate/gcc/dist-common.sh | 337 + src/translate/gcc/dist.sh | 471 + src/translate/gcc/lang-options.h | 29 + src/translate/gcc/lang-specs.h | 28 + src/translate/ghdldrv/Makefile | 193 + src/translate/ghdldrv/default_pathes.ads.in | 39 + src/translate/ghdldrv/foreigns.adb | 64 + src/translate/ghdldrv/foreigns.ads | 5 + src/translate/ghdldrv/ghdl_gcc.adb | 34 + src/translate/ghdldrv/ghdl_jit.adb | 35 + src/translate/ghdldrv/ghdl_simul.adb | 33 + src/translate/ghdldrv/ghdlcomp.adb | 757 + src/translate/ghdldrv/ghdlcomp.ads | 67 + src/translate/ghdldrv/ghdldrv.adb | 1818 ++ src/translate/ghdldrv/ghdldrv.ads | 25 + src/translate/ghdldrv/ghdllocal.adb | 1415 + src/translate/ghdldrv/ghdllocal.ads | 116 + src/translate/ghdldrv/ghdlmain.adb | 359 + src/translate/ghdldrv/ghdlmain.ads | 85 + src/translate/ghdldrv/ghdlprint.adb | 1757 ++ src/translate/ghdldrv/ghdlprint.ads | 20 + src/translate/ghdldrv/ghdlrun.adb | 661 + src/translate/ghdldrv/ghdlrun.ads | 20 + src/translate/ghdldrv/ghdlsimul.adb | 209 + src/translate/ghdldrv/ghdlsimul.ads | 20 + src/translate/ghdldrv/grtlink.ads | 39 + src/translate/grt/Makefile | 56 + src/translate/grt/Makefile.inc | 226 + src/translate/grt/config/Makefile | 14 + src/translate/grt/config/amd64.S | 131 + src/translate/grt/config/chkstk.S | 53 + src/translate/grt/config/clock.c | 43 + src/translate/grt/config/i386.S | 141 + src/translate/grt/config/ia64.S | 331 + src/translate/grt/config/linux.c | 361 + src/translate/grt/config/ppc.S | 334 + src/translate/grt/config/pthread.c | 239 + src/translate/grt/config/sparc.S | 141 + src/translate/grt/config/teststack.c | 174 + src/translate/grt/config/times.c | 55 + src/translate/grt/config/win32.c | 265 + src/translate/grt/config/win32thr.c | 167 + src/translate/grt/ghdl_main.adb | 61 + src/translate/grt/ghdl_main.ads | 33 + src/translate/grt/ghwdump.c | 195 + src/translate/grt/ghwlib.c | 1746 ++ src/translate/grt/ghwlib.h | 399 + src/translate/grt/grt-arch.ads | 2 + src/translate/grt/grt-arch_none.adb | 7 + src/translate/grt/grt-arch_none.ads | 6 + src/translate/grt/grt-astdio.adb | 231 + src/translate/grt/grt-astdio.ads | 60 + src/translate/grt/grt-avhpi.adb | 1142 + src/translate/grt/grt-avhpi.ads | 561 + src/translate/grt/grt-avls.adb | 249 + src/translate/grt/grt-avls.ads | 84 + src/translate/grt/grt-c.ads | 54 + src/translate/grt/grt-cbinding.c | 99 + src/translate/grt/grt-cvpi.c | 277 + src/translate/grt/grt-disp.adb | 227 + src/translate/grt/grt-disp.ads | 46 + src/translate/grt/grt-disp_rti.adb | 1080 + src/translate/grt/grt-disp_rti.ads | 43 + src/translate/grt/grt-disp_signals.adb | 524 + src/translate/grt/grt-disp_signals.ads | 48 + src/translate/grt/grt-disp_tree.adb | 461 + src/translate/grt/grt-disp_tree.ads | 27 + src/translate/grt/grt-errors.adb | 253 + src/translate/grt/grt-errors.ads | 84 + src/translate/grt/grt-files.adb | 452 + src/translate/grt/grt-files.ads | 123 + src/translate/grt/grt-hooks.adb | 161 + src/translate/grt/grt-hooks.ads | 70 + src/translate/grt/grt-images.adb | 387 + src/translate/grt/grt-images.ads | 110 + src/translate/grt/grt-lib.adb | 298 + src/translate/grt/grt-lib.ads | 127 + src/translate/grt/grt-main.adb | 190 + src/translate/grt/grt-main.ads | 29 + src/translate/grt/grt-modules.adb | 47 + src/translate/grt/grt-modules.ads | 29 + src/translate/grt/grt-names.adb | 105 + src/translate/grt/grt-names.ads | 42 + src/translate/grt/grt-options.adb | 507 + src/translate/grt/grt-options.ads | 154 + src/translate/grt/grt-processes.adb | 1042 + src/translate/grt/grt-processes.ads | 260 + src/translate/grt/grt-readline.ads | 30 + src/translate/grt/grt-rtis.adb | 45 + src/translate/grt/grt-rtis.ads | 379 + src/translate/grt/grt-rtis_addr.adb | 299 + src/translate/grt/grt-rtis_addr.ads | 110 + src/translate/grt/grt-rtis_binding.ads | 67 + src/translate/grt/grt-rtis_types.adb | 118 + src/translate/grt/grt-rtis_types.ads | 55 + src/translate/grt/grt-rtis_utils.adb | 660 + src/translate/grt/grt-rtis_utils.ads | 92 + src/translate/grt/grt-sdf.adb | 1389 + src/translate/grt/grt-sdf.ads | 131 + src/translate/grt/grt-shadow_ieee.adb | 32 + src/translate/grt/grt-shadow_ieee.ads | 41 + src/translate/grt/grt-signals.adb | 3400 ++ src/translate/grt/grt-signals.ads | 919 + src/translate/grt/grt-stack2.adb | 205 + src/translate/grt/grt-stack2.ads | 43 + src/translate/grt/grt-stacks.adb | 43 + src/translate/grt/grt-stacks.ads | 87 + src/translate/grt/grt-stats.adb | 370 + src/translate/grt/grt-stats.ads | 54 + src/translate/grt/grt-std_logic_1164.adb | 146 + src/translate/grt/grt-std_logic_1164.ads | 124 + src/translate/grt/grt-stdio.ads | 107 + src/translate/grt/grt-table.adb | 120 + src/translate/grt/grt-table.ads | 75 + src/translate/grt/grt-threads.ads | 27 + src/translate/grt/grt-types.ads | 327 + src/translate/grt/grt-unithread.adb | 106 + src/translate/grt/grt-unithread.ads | 73 + src/translate/grt/grt-values.adb | 639 + src/translate/grt/grt-values.ads | 69 + src/translate/grt/grt-vcd.adb | 845 + src/translate/grt/grt-vcd.ads | 65 + src/translate/grt/grt-vcdz.adb | 116 + src/translate/grt/grt-vcdz.ads | 28 + src/translate/grt/grt-vital_annotate.adb | 688 + src/translate/grt/grt-vital_annotate.ads | 42 + src/translate/grt/grt-vpi.adb | 988 + src/translate/grt/grt-vpi.ads | 252 + src/translate/grt/grt-vstrings.adb | 422 + src/translate/grt/grt-vstrings.ads | 143 + src/translate/grt/grt-waves.adb | 1632 + src/translate/grt/grt-waves.ads | 27 + src/translate/grt/grt-zlib.ads | 47 + src/translate/grt/grt.adc | 46 + src/translate/grt/grt.ads | 27 + src/translate/grt/grt.ver | 25 + src/translate/grt/main.adb | 32 + src/translate/grt/main.ads | 34 + src/translate/mcode/Makefile.in | 54 + src/translate/mcode/README | 47 + src/translate/mcode/dist.sh | 506 + src/translate/mcode/winbuild.bat | 18 + src/translate/mcode/windows/compile.bat | 24 + src/translate/mcode/windows/complib.bat | 68 + src/translate/mcode/windows/default_pathes.ads | 8 + src/translate/mcode/windows/ghdl.nsi | 455 + src/translate/mcode/windows/ghdlfilter.adb | 58 + src/translate/mcode/windows/ghdlversion.adb | 30 + src/translate/mcode/windows/grt-modules.adb | 37 + .../mcode/windows/ortho_code-x86-flags.ads | 2 + .../mcode/windows/windows_default_path.adb | 45 + .../mcode/windows/windows_default_path.ads | 5 + src/translate/ortho_front.adb | 445 + src/translate/trans_analyzes.adb | 182 + src/translate/trans_analyzes.ads | 31 + src/translate/trans_be.adb | 182 + src/translate/trans_be.ads | 21 + src/translate/trans_decls.ads | 257 + src/translate/translation.adb | 31355 +++++++++++++++++++ src/translate/translation.ads | 120 + src/types.ads | 127 + src/version.ads | 5 + src/xrefs.adb | 279 + src/xrefs.ads | 108 + src/xtools/Makefile | 35 + src/xtools/pnodes.py | 716 + std_names.adb | 482 - std_names.ads | 727 - std_package.adb | 1200 - std_package.ads | 182 - str_table.adb | 92 - str_table.ads | 44 - tokens.adb | 443 - tokens.ads | 279 - translate/Makefile | 45 - translate/gcc/ANNOUNCE | 21 - translate/gcc/INSTALL | 24 - translate/gcc/Make-lang.in | 190 - translate/gcc/Makefile.in | 299 - translate/gcc/README | 87 - translate/gcc/config-lang.in | 38 - translate/gcc/dist-common.sh | 337 - translate/gcc/dist.sh | 471 - translate/gcc/lang-options.h | 29 - translate/gcc/lang-specs.h | 28 - translate/ghdldrv/Makefile | 193 - translate/ghdldrv/default_pathes.ads.in | 39 - translate/ghdldrv/foreigns.adb | 64 - translate/ghdldrv/foreigns.ads | 5 - translate/ghdldrv/ghdl_gcc.adb | 34 - translate/ghdldrv/ghdl_jit.adb | 35 - translate/ghdldrv/ghdl_simul.adb | 33 - translate/ghdldrv/ghdlcomp.adb | 757 - translate/ghdldrv/ghdlcomp.ads | 67 - translate/ghdldrv/ghdldrv.adb | 1818 -- translate/ghdldrv/ghdldrv.ads | 25 - translate/ghdldrv/ghdllocal.adb | 1415 - translate/ghdldrv/ghdllocal.ads | 116 - translate/ghdldrv/ghdlmain.adb | 359 - translate/ghdldrv/ghdlmain.ads | 85 - translate/ghdldrv/ghdlprint.adb | 1757 -- translate/ghdldrv/ghdlprint.ads | 20 - translate/ghdldrv/ghdlrun.adb | 661 - translate/ghdldrv/ghdlrun.ads | 20 - translate/ghdldrv/ghdlsimul.adb | 209 - translate/ghdldrv/ghdlsimul.ads | 20 - translate/ghdldrv/grtlink.ads | 39 - translate/grt/Makefile | 56 - translate/grt/Makefile.inc | 226 - translate/grt/config/Makefile | 14 - translate/grt/config/amd64.S | 131 - translate/grt/config/chkstk.S | 53 - translate/grt/config/clock.c | 43 - translate/grt/config/i386.S | 141 - translate/grt/config/ia64.S | 331 - translate/grt/config/linux.c | 361 - translate/grt/config/ppc.S | 334 - translate/grt/config/pthread.c | 239 - translate/grt/config/sparc.S | 141 - translate/grt/config/teststack.c | 174 - translate/grt/config/times.c | 55 - translate/grt/config/win32.c | 265 - translate/grt/config/win32thr.c | 167 - translate/grt/ghdl_main.adb | 61 - translate/grt/ghdl_main.ads | 33 - translate/grt/ghwdump.c | 195 - translate/grt/ghwlib.c | 1746 -- translate/grt/ghwlib.h | 399 - translate/grt/grt-arch.ads | 2 - translate/grt/grt-arch_none.adb | 7 - translate/grt/grt-arch_none.ads | 6 - translate/grt/grt-astdio.adb | 231 - translate/grt/grt-astdio.ads | 60 - translate/grt/grt-avhpi.adb | 1142 - translate/grt/grt-avhpi.ads | 561 - translate/grt/grt-avls.adb | 249 - translate/grt/grt-avls.ads | 84 - translate/grt/grt-c.ads | 54 - translate/grt/grt-cbinding.c | 99 - translate/grt/grt-cvpi.c | 277 - translate/grt/grt-disp.adb | 227 - translate/grt/grt-disp.ads | 46 - translate/grt/grt-disp_rti.adb | 1080 - translate/grt/grt-disp_rti.ads | 43 - translate/grt/grt-disp_signals.adb | 524 - translate/grt/grt-disp_signals.ads | 48 - translate/grt/grt-disp_tree.adb | 461 - translate/grt/grt-disp_tree.ads | 27 - translate/grt/grt-errors.adb | 253 - translate/grt/grt-errors.ads | 84 - translate/grt/grt-files.adb | 452 - translate/grt/grt-files.ads | 123 - translate/grt/grt-hooks.adb | 161 - translate/grt/grt-hooks.ads | 70 - translate/grt/grt-images.adb | 387 - translate/grt/grt-images.ads | 110 - translate/grt/grt-lib.adb | 298 - translate/grt/grt-lib.ads | 127 - translate/grt/grt-main.adb | 190 - translate/grt/grt-main.ads | 29 - translate/grt/grt-modules.adb | 47 - translate/grt/grt-modules.ads | 29 - translate/grt/grt-names.adb | 105 - translate/grt/grt-names.ads | 42 - translate/grt/grt-options.adb | 507 - translate/grt/grt-options.ads | 154 - translate/grt/grt-processes.adb | 1042 - translate/grt/grt-processes.ads | 260 - translate/grt/grt-readline.ads | 30 - translate/grt/grt-rtis.adb | 45 - translate/grt/grt-rtis.ads | 379 - translate/grt/grt-rtis_addr.adb | 299 - translate/grt/grt-rtis_addr.ads | 110 - translate/grt/grt-rtis_binding.ads | 67 - translate/grt/grt-rtis_types.adb | 118 - translate/grt/grt-rtis_types.ads | 55 - translate/grt/grt-rtis_utils.adb | 660 - translate/grt/grt-rtis_utils.ads | 92 - translate/grt/grt-sdf.adb | 1389 - translate/grt/grt-sdf.ads | 131 - translate/grt/grt-shadow_ieee.adb | 32 - translate/grt/grt-shadow_ieee.ads | 41 - translate/grt/grt-signals.adb | 3400 -- translate/grt/grt-signals.ads | 919 - translate/grt/grt-stack2.adb | 205 - translate/grt/grt-stack2.ads | 43 - translate/grt/grt-stacks.adb | 43 - translate/grt/grt-stacks.ads | 87 - translate/grt/grt-stats.adb | 370 - translate/grt/grt-stats.ads | 54 - translate/grt/grt-std_logic_1164.adb | 146 - translate/grt/grt-std_logic_1164.ads | 124 - translate/grt/grt-stdio.ads | 107 - translate/grt/grt-table.adb | 120 - translate/grt/grt-table.ads | 75 - translate/grt/grt-threads.ads | 27 - translate/grt/grt-types.ads | 327 - translate/grt/grt-unithread.adb | 106 - translate/grt/grt-unithread.ads | 73 - translate/grt/grt-values.adb | 639 - translate/grt/grt-values.ads | 69 - translate/grt/grt-vcd.adb | 845 - translate/grt/grt-vcd.ads | 65 - translate/grt/grt-vcdz.adb | 116 - translate/grt/grt-vcdz.ads | 28 - translate/grt/grt-vital_annotate.adb | 688 - translate/grt/grt-vital_annotate.ads | 42 - translate/grt/grt-vpi.adb | 988 - translate/grt/grt-vpi.ads | 252 - translate/grt/grt-vstrings.adb | 422 - translate/grt/grt-vstrings.ads | 143 - translate/grt/grt-waves.adb | 1632 - translate/grt/grt-waves.ads | 27 - translate/grt/grt-zlib.ads | 47 - translate/grt/grt.adc | 46 - translate/grt/grt.ads | 27 - translate/grt/grt.ver | 25 - translate/grt/main.adb | 32 - translate/grt/main.ads | 34 - translate/mcode/Makefile.in | 54 - translate/mcode/README | 47 - translate/mcode/dist.sh | 506 - translate/mcode/winbuild.bat | 18 - translate/mcode/windows/compile.bat | 24 - translate/mcode/windows/complib.bat | 68 - translate/mcode/windows/default_pathes.ads | 8 - translate/mcode/windows/ghdl.nsi | 455 - translate/mcode/windows/ghdlfilter.adb | 58 - translate/mcode/windows/ghdlversion.adb | 30 - translate/mcode/windows/grt-modules.adb | 37 - translate/mcode/windows/ortho_code-x86-flags.ads | 2 - translate/mcode/windows/windows_default_path.adb | 45 - translate/mcode/windows/windows_default_path.ads | 5 - translate/ortho_front.adb | 445 - translate/trans_analyzes.adb | 182 - translate/trans_analyzes.ads | 31 - translate/trans_be.adb | 182 - translate/trans_be.ads | 21 - translate/trans_decls.ads | 257 - translate/translation.adb | 31355 ------------------- translate/translation.ads | 120 - types.ads | 127 - version.ads | 5 - xrefs.adb | 279 - xrefs.ads | 108 - xtools/Makefile | 35 - xtools/pnodes.py | 716 - 902 files changed, 222443 insertions(+), 222443 deletions(-) delete mode 100644 back_end.adb delete mode 100644 back_end.ads delete mode 100644 bug.adb delete mode 100644 bug.ads delete mode 100644 canon.adb delete mode 100644 canon.ads delete mode 100644 canon_psl.adb delete mode 100644 canon_psl.ads delete mode 100644 configuration.adb delete mode 100644 configuration.ads delete mode 100644 disp_tree.adb delete mode 100644 disp_tree.ads delete mode 100644 disp_vhdl.adb delete mode 100644 disp_vhdl.ads delete mode 100644 errorout.adb delete mode 100644 errorout.ads delete mode 100644 evaluation.adb delete mode 100644 evaluation.ads delete mode 100644 files_map.adb delete mode 100644 files_map.ads delete mode 100644 flags.adb delete mode 100644 flags.ads delete mode 100644 ieee-std_logic_1164.adb delete mode 100644 ieee-std_logic_1164.ads delete mode 100644 ieee-vital_timing.adb delete mode 100644 ieee-vital_timing.ads delete mode 100644 ieee.ads delete mode 100644 iir_chain_handling.adb delete mode 100644 iir_chain_handling.ads delete mode 100644 iir_chains.adb delete mode 100644 iir_chains.ads delete mode 100644 iirs.adb delete mode 100644 iirs.adb.in delete mode 100644 iirs.ads delete mode 100644 iirs_utils.adb delete mode 100644 iirs_utils.ads delete mode 100644 iirs_walk.adb delete mode 100644 iirs_walk.ads delete mode 100644 libraries.adb delete mode 100644 libraries.ads delete mode 100644 lists.adb delete mode 100644 lists.ads delete mode 100644 name_table.adb delete mode 100644 name_table.ads delete mode 100644 nodes.adb delete mode 100644 nodes.ads delete mode 100644 nodes_gc.adb delete mode 100644 nodes_gc.adb.in delete mode 100644 nodes_gc.ads delete mode 100644 nodes_meta.adb delete mode 100644 nodes_meta.adb.in delete mode 100644 nodes_meta.ads delete mode 100644 nodes_meta.ads.in delete mode 100644 options.adb delete mode 100644 options.ads delete mode 100644 ortho/Makefile.inc delete mode 100644 ortho/debug/Makefile delete mode 100644 ortho/debug/ortho_debug-disp.adb delete mode 100644 ortho/debug/ortho_debug-disp.ads delete mode 100644 ortho/debug/ortho_debug-main.adb delete mode 100644 ortho/debug/ortho_debug.adb delete mode 100644 ortho/debug/ortho_debug.private.ads delete mode 100644 ortho/debug/ortho_debug_front.ads delete mode 100644 ortho/debug/ortho_ident.ads delete mode 100644 ortho/debug/ortho_ident_hash.adb delete mode 100644 ortho/debug/ortho_ident_hash.ads delete mode 100644 ortho/debug/ortho_ident_simple.adb delete mode 100644 ortho/debug/ortho_ident_simple.ads delete mode 100644 ortho/debug/ortho_nodes.ads delete mode 100644 ortho/gcc/Makefile delete mode 100644 ortho/gcc/Makefile.conf.linux delete mode 100644 ortho/gcc/lang.opt delete mode 100644 ortho/gcc/ortho-lang.c delete mode 100644 ortho/gcc/ortho_gcc-main.adb delete mode 100644 ortho/gcc/ortho_gcc-main.ads delete mode 100644 ortho/gcc/ortho_gcc.adb delete mode 100644 ortho/gcc/ortho_gcc.ads delete mode 100644 ortho/gcc/ortho_gcc.private.ads delete mode 100644 ortho/gcc/ortho_gcc_front.ads delete mode 100644 ortho/gcc/ortho_ident.adb delete mode 100644 ortho/gcc/ortho_ident.ads delete mode 100644 ortho/gcc/ortho_nodes.ads delete mode 100644 ortho/llvm/Makefile delete mode 100644 ortho/llvm/llvm-analysis.ads delete mode 100644 ortho/llvm/llvm-bitwriter.ads delete mode 100644 ortho/llvm/llvm-cbindings.cpp delete mode 100644 ortho/llvm/llvm-core.ads delete mode 100644 ortho/llvm/llvm-executionengine.ads delete mode 100644 ortho/llvm/llvm-target.ads delete mode 100644 ortho/llvm/llvm-targetmachine.ads delete mode 100644 ortho/llvm/llvm-transforms-scalar.ads delete mode 100644 ortho/llvm/llvm-transforms.ads delete mode 100644 ortho/llvm/llvm.ads delete mode 100644 ortho/llvm/ortho_code_main.adb delete mode 100644 ortho/llvm/ortho_ident.adb delete mode 100644 ortho/llvm/ortho_ident.ads delete mode 100644 ortho/llvm/ortho_jit.adb delete mode 100644 ortho/llvm/ortho_llvm-jit.adb delete mode 100644 ortho/llvm/ortho_llvm-jit.ads delete mode 100644 ortho/llvm/ortho_llvm.adb delete mode 100644 ortho/llvm/ortho_llvm.ads delete mode 100644 ortho/llvm/ortho_llvm.private.ads delete mode 100644 ortho/llvm/ortho_nodes.ads delete mode 100644 ortho/mcode/Makefile delete mode 100644 ortho/mcode/binary_file-coff.adb delete mode 100644 ortho/mcode/binary_file-coff.ads delete mode 100644 ortho/mcode/binary_file-elf.adb delete mode 100644 ortho/mcode/binary_file-elf.ads delete mode 100644 ortho/mcode/binary_file-memory.adb delete mode 100644 ortho/mcode/binary_file-memory.ads delete mode 100644 ortho/mcode/binary_file.adb delete mode 100644 ortho/mcode/binary_file.ads delete mode 100644 ortho/mcode/coff.ads delete mode 100644 ortho/mcode/coffdump.adb delete mode 100644 ortho/mcode/disa_sparc.adb delete mode 100644 ortho/mcode/disa_sparc.ads delete mode 100644 ortho/mcode/disa_x86.adb delete mode 100644 ortho/mcode/disa_x86.ads delete mode 100644 ortho/mcode/disassemble.ads delete mode 100644 ortho/mcode/dwarf.ads delete mode 100644 ortho/mcode/elf32.adb delete mode 100644 ortho/mcode/elf32.ads delete mode 100644 ortho/mcode/elf64.ads delete mode 100644 ortho/mcode/elf_arch.ads delete mode 100644 ortho/mcode/elf_arch32.ads delete mode 100644 ortho/mcode/elf_arch64.ads delete mode 100644 ortho/mcode/elf_common.adb delete mode 100644 ortho/mcode/elf_common.ads delete mode 100644 ortho/mcode/elfdump.adb delete mode 100644 ortho/mcode/elfdumper.adb delete mode 100644 ortho/mcode/elfdumper.ads delete mode 100644 ortho/mcode/hex_images.adb delete mode 100644 ortho/mcode/hex_images.ads delete mode 100644 ortho/mcode/memsegs.ads delete mode 100644 ortho/mcode/memsegs_c.c delete mode 100644 ortho/mcode/memsegs_mmap.adb delete mode 100644 ortho/mcode/memsegs_mmap.ads delete mode 100644 ortho/mcode/ortho_code-abi.ads delete mode 100644 ortho/mcode/ortho_code-binary.adb delete mode 100644 ortho/mcode/ortho_code-binary.ads delete mode 100644 ortho/mcode/ortho_code-consts.adb delete mode 100644 ortho/mcode/ortho_code-consts.ads delete mode 100644 ortho/mcode/ortho_code-debug.adb delete mode 100644 ortho/mcode/ortho_code-debug.ads delete mode 100644 ortho/mcode/ortho_code-decls.adb delete mode 100644 ortho/mcode/ortho_code-decls.ads delete mode 100644 ortho/mcode/ortho_code-disps.adb delete mode 100644 ortho/mcode/ortho_code-disps.ads delete mode 100644 ortho/mcode/ortho_code-dwarf.adb delete mode 100644 ortho/mcode/ortho_code-dwarf.ads delete mode 100644 ortho/mcode/ortho_code-exprs.adb delete mode 100644 ortho/mcode/ortho_code-exprs.ads delete mode 100644 ortho/mcode/ortho_code-flags.ads delete mode 100644 ortho/mcode/ortho_code-opts.adb delete mode 100644 ortho/mcode/ortho_code-opts.ads delete mode 100644 ortho/mcode/ortho_code-types.adb delete mode 100644 ortho/mcode/ortho_code-types.ads delete mode 100644 ortho/mcode/ortho_code-x86-abi.adb delete mode 100644 ortho/mcode/ortho_code-x86-abi.ads delete mode 100644 ortho/mcode/ortho_code-x86-emits.adb delete mode 100644 ortho/mcode/ortho_code-x86-emits.ads delete mode 100644 ortho/mcode/ortho_code-x86-flags_linux.ads delete mode 100644 ortho/mcode/ortho_code-x86-flags_macosx.ads delete mode 100644 ortho/mcode/ortho_code-x86-flags_windows.ads delete mode 100644 ortho/mcode/ortho_code-x86-insns.adb delete mode 100644 ortho/mcode/ortho_code-x86-insns.ads delete mode 100644 ortho/mcode/ortho_code-x86.adb delete mode 100644 ortho/mcode/ortho_code-x86.ads delete mode 100644 ortho/mcode/ortho_code.ads delete mode 100644 ortho/mcode/ortho_code_main.adb delete mode 100644 ortho/mcode/ortho_ident.adb delete mode 100644 ortho/mcode/ortho_ident.ads delete mode 100644 ortho/mcode/ortho_jit.adb delete mode 100644 ortho/mcode/ortho_mcode-jit.adb delete mode 100644 ortho/mcode/ortho_mcode-jit.ads delete mode 100644 ortho/mcode/ortho_mcode.adb delete mode 100644 ortho/mcode/ortho_mcode.ads delete mode 100644 ortho/mcode/ortho_mcode.private.ads delete mode 100644 ortho/mcode/ortho_nodes.ads delete mode 100644 ortho/oread/Makefile delete mode 100644 ortho/oread/ortho_front.adb delete mode 100644 ortho/ortho_front.ads delete mode 100644 ortho/ortho_jit.ads delete mode 100644 ortho/ortho_nodes.common.ads delete mode 100644 parse.adb delete mode 100644 parse.ads delete mode 100644 parse_psl.adb delete mode 100644 parse_psl.ads delete mode 100644 post_sems.adb delete mode 100644 post_sems.ads delete mode 100644 psl-errors.ads delete mode 100644 psl/psl-build.adb delete mode 100644 psl/psl-build.ads delete mode 100644 psl/psl-cse.adb delete mode 100644 psl/psl-cse.ads delete mode 100644 psl/psl-disp_nfas.adb delete mode 100644 psl/psl-disp_nfas.ads delete mode 100644 psl/psl-dump_tree.adb delete mode 100644 psl/psl-dump_tree.ads delete mode 100644 psl/psl-hash.adb delete mode 100644 psl/psl-hash.ads delete mode 100644 psl/psl-nfas-utils.adb delete mode 100644 psl/psl-nfas-utils.ads delete mode 100644 psl/psl-nfas.adb delete mode 100644 psl/psl-nfas.ads delete mode 100644 psl/psl-nodes.adb delete mode 100644 psl/psl-nodes.ads delete mode 100644 psl/psl-optimize.adb delete mode 100644 psl/psl-optimize.ads delete mode 100644 psl/psl-prints.adb delete mode 100644 psl/psl-prints.ads delete mode 100644 psl/psl-priorities.ads delete mode 100644 psl/psl-qm.adb delete mode 100644 psl/psl-qm.ads delete mode 100644 psl/psl-rewrites.adb delete mode 100644 psl/psl-rewrites.ads delete mode 100644 psl/psl-subsets.adb delete mode 100644 psl/psl-subsets.ads delete mode 100644 psl/psl-tprint.adb delete mode 100644 psl/psl-tprint.ads delete mode 100644 psl/psl.ads delete mode 100644 scanner-scan_literal.adb delete mode 100644 scanner.adb delete mode 100644 scanner.ads delete mode 100644 sem.adb delete mode 100644 sem.ads delete mode 100644 sem_assocs.adb delete mode 100644 sem_assocs.ads delete mode 100644 sem_decls.adb delete mode 100644 sem_decls.ads delete mode 100644 sem_expr.adb delete mode 100644 sem_expr.ads delete mode 100644 sem_inst.adb delete mode 100644 sem_inst.ads delete mode 100644 sem_names.adb delete mode 100644 sem_names.ads delete mode 100644 sem_psl.adb delete mode 100644 sem_psl.ads delete mode 100644 sem_scopes.adb delete mode 100644 sem_scopes.ads delete mode 100644 sem_specs.adb delete mode 100644 sem_specs.ads delete mode 100644 sem_stmts.adb delete mode 100644 sem_stmts.ads delete mode 100644 sem_types.adb delete mode 100644 sem_types.ads delete mode 100644 simulate/annotations.adb delete mode 100644 simulate/annotations.ads delete mode 100644 simulate/areapools.adb delete mode 100644 simulate/areapools.ads delete mode 100644 simulate/debugger.adb delete mode 100644 simulate/debugger.ads delete mode 100644 simulate/elaboration.adb delete mode 100644 simulate/elaboration.ads delete mode 100644 simulate/execution.adb delete mode 100644 simulate/execution.ads delete mode 100644 simulate/file_operation.adb delete mode 100644 simulate/file_operation.ads delete mode 100644 simulate/grt_interface.adb delete mode 100644 simulate/grt_interface.ads delete mode 100644 simulate/iir_values.adb delete mode 100644 simulate/iir_values.ads delete mode 100644 simulate/sim_be.adb delete mode 100644 simulate/sim_be.ads delete mode 100644 simulate/simulation-ams-debugger.adb delete mode 100644 simulate/simulation-ams-debugger.ads delete mode 100644 simulate/simulation-ams.adb delete mode 100644 simulate/simulation-ams.ads delete mode 100644 simulate/simulation.adb delete mode 100644 simulate/simulation.ads create mode 100644 src/back_end.adb create mode 100644 src/back_end.ads create mode 100644 src/bug.adb create mode 100644 src/bug.ads create mode 100644 src/canon.adb create mode 100644 src/canon.ads create mode 100644 src/canon_psl.adb create mode 100644 src/canon_psl.ads create mode 100644 src/configuration.adb create mode 100644 src/configuration.ads create mode 100644 src/disp_tree.adb create mode 100644 src/disp_tree.ads create mode 100644 src/disp_vhdl.adb create mode 100644 src/disp_vhdl.ads create mode 100644 src/errorout.adb create mode 100644 src/errorout.ads create mode 100644 src/evaluation.adb create mode 100644 src/evaluation.ads create mode 100644 src/files_map.adb create mode 100644 src/files_map.ads create mode 100644 src/flags.adb create mode 100644 src/flags.ads create mode 100644 src/ieee-std_logic_1164.adb create mode 100644 src/ieee-std_logic_1164.ads create mode 100644 src/ieee-vital_timing.adb create mode 100644 src/ieee-vital_timing.ads create mode 100644 src/ieee.ads create mode 100644 src/iir_chain_handling.adb create mode 100644 src/iir_chain_handling.ads create mode 100644 src/iir_chains.adb create mode 100644 src/iir_chains.ads create mode 100644 src/iirs.adb create mode 100644 src/iirs.adb.in create mode 100644 src/iirs.ads create mode 100644 src/iirs_utils.adb create mode 100644 src/iirs_utils.ads create mode 100644 src/iirs_walk.adb create mode 100644 src/iirs_walk.ads create mode 100644 src/libraries.adb create mode 100644 src/libraries.ads create mode 100644 src/lists.adb create mode 100644 src/lists.ads create mode 100644 src/name_table.adb create mode 100644 src/name_table.ads create mode 100644 src/nodes.adb create mode 100644 src/nodes.ads create mode 100644 src/nodes_gc.adb create mode 100644 src/nodes_gc.adb.in create mode 100644 src/nodes_gc.ads create mode 100644 src/nodes_meta.adb create mode 100644 src/nodes_meta.adb.in create mode 100644 src/nodes_meta.ads create mode 100644 src/nodes_meta.ads.in create mode 100644 src/options.adb create mode 100644 src/options.ads create mode 100644 src/ortho/Makefile.inc create mode 100644 src/ortho/debug/Makefile create mode 100644 src/ortho/debug/ortho_debug-disp.adb create mode 100644 src/ortho/debug/ortho_debug-disp.ads create mode 100644 src/ortho/debug/ortho_debug-main.adb create mode 100644 src/ortho/debug/ortho_debug.adb create mode 100644 src/ortho/debug/ortho_debug.private.ads create mode 100644 src/ortho/debug/ortho_debug_front.ads create mode 100644 src/ortho/debug/ortho_ident.ads create mode 100644 src/ortho/debug/ortho_ident_hash.adb create mode 100644 src/ortho/debug/ortho_ident_hash.ads create mode 100644 src/ortho/debug/ortho_ident_simple.adb create mode 100644 src/ortho/debug/ortho_ident_simple.ads create mode 100644 src/ortho/debug/ortho_nodes.ads create mode 100644 src/ortho/gcc/Makefile create mode 100644 src/ortho/gcc/Makefile.conf.linux create mode 100644 src/ortho/gcc/lang.opt create mode 100644 src/ortho/gcc/ortho-lang.c create mode 100644 src/ortho/gcc/ortho_gcc-main.adb create mode 100644 src/ortho/gcc/ortho_gcc-main.ads create mode 100644 src/ortho/gcc/ortho_gcc.adb create mode 100644 src/ortho/gcc/ortho_gcc.ads create mode 100644 src/ortho/gcc/ortho_gcc.private.ads create mode 100644 src/ortho/gcc/ortho_gcc_front.ads create mode 100644 src/ortho/gcc/ortho_ident.adb create mode 100644 src/ortho/gcc/ortho_ident.ads create mode 100644 src/ortho/gcc/ortho_nodes.ads create mode 100644 src/ortho/llvm/Makefile create mode 100644 src/ortho/llvm/llvm-analysis.ads create mode 100644 src/ortho/llvm/llvm-bitwriter.ads create mode 100644 src/ortho/llvm/llvm-cbindings.cpp create mode 100644 src/ortho/llvm/llvm-core.ads create mode 100644 src/ortho/llvm/llvm-executionengine.ads create mode 100644 src/ortho/llvm/llvm-target.ads create mode 100644 src/ortho/llvm/llvm-targetmachine.ads create mode 100644 src/ortho/llvm/llvm-transforms-scalar.ads create mode 100644 src/ortho/llvm/llvm-transforms.ads create mode 100644 src/ortho/llvm/llvm.ads create mode 100644 src/ortho/llvm/ortho_code_main.adb create mode 100644 src/ortho/llvm/ortho_ident.adb create mode 100644 src/ortho/llvm/ortho_ident.ads create mode 100644 src/ortho/llvm/ortho_jit.adb create mode 100644 src/ortho/llvm/ortho_llvm-jit.adb create mode 100644 src/ortho/llvm/ortho_llvm-jit.ads create mode 100644 src/ortho/llvm/ortho_llvm.adb create mode 100644 src/ortho/llvm/ortho_llvm.ads create mode 100644 src/ortho/llvm/ortho_llvm.private.ads create mode 100644 src/ortho/llvm/ortho_nodes.ads create mode 100644 src/ortho/mcode/Makefile create mode 100644 src/ortho/mcode/binary_file-coff.adb create mode 100644 src/ortho/mcode/binary_file-coff.ads create mode 100644 src/ortho/mcode/binary_file-elf.adb create mode 100644 src/ortho/mcode/binary_file-elf.ads create mode 100644 src/ortho/mcode/binary_file-memory.adb create mode 100644 src/ortho/mcode/binary_file-memory.ads create mode 100644 src/ortho/mcode/binary_file.adb create mode 100644 src/ortho/mcode/binary_file.ads create mode 100644 src/ortho/mcode/coff.ads create mode 100644 src/ortho/mcode/coffdump.adb create mode 100644 src/ortho/mcode/disa_sparc.adb create mode 100644 src/ortho/mcode/disa_sparc.ads create mode 100644 src/ortho/mcode/disa_x86.adb create mode 100644 src/ortho/mcode/disa_x86.ads create mode 100644 src/ortho/mcode/disassemble.ads create mode 100644 src/ortho/mcode/dwarf.ads create mode 100644 src/ortho/mcode/elf32.adb create mode 100644 src/ortho/mcode/elf32.ads create mode 100644 src/ortho/mcode/elf64.ads create mode 100644 src/ortho/mcode/elf_arch.ads create mode 100644 src/ortho/mcode/elf_arch32.ads create mode 100644 src/ortho/mcode/elf_arch64.ads create mode 100644 src/ortho/mcode/elf_common.adb create mode 100644 src/ortho/mcode/elf_common.ads create mode 100644 src/ortho/mcode/elfdump.adb create mode 100644 src/ortho/mcode/elfdumper.adb create mode 100644 src/ortho/mcode/elfdumper.ads create mode 100644 src/ortho/mcode/hex_images.adb create mode 100644 src/ortho/mcode/hex_images.ads create mode 100644 src/ortho/mcode/memsegs.ads create mode 100644 src/ortho/mcode/memsegs_c.c create mode 100644 src/ortho/mcode/memsegs_mmap.adb create mode 100644 src/ortho/mcode/memsegs_mmap.ads create mode 100644 src/ortho/mcode/ortho_code-abi.ads create mode 100644 src/ortho/mcode/ortho_code-binary.adb create mode 100644 src/ortho/mcode/ortho_code-binary.ads create mode 100644 src/ortho/mcode/ortho_code-consts.adb create mode 100644 src/ortho/mcode/ortho_code-consts.ads create mode 100644 src/ortho/mcode/ortho_code-debug.adb create mode 100644 src/ortho/mcode/ortho_code-debug.ads create mode 100644 src/ortho/mcode/ortho_code-decls.adb create mode 100644 src/ortho/mcode/ortho_code-decls.ads create mode 100644 src/ortho/mcode/ortho_code-disps.adb create mode 100644 src/ortho/mcode/ortho_code-disps.ads create mode 100644 src/ortho/mcode/ortho_code-dwarf.adb create mode 100644 src/ortho/mcode/ortho_code-dwarf.ads create mode 100644 src/ortho/mcode/ortho_code-exprs.adb create mode 100644 src/ortho/mcode/ortho_code-exprs.ads create mode 100644 src/ortho/mcode/ortho_code-flags.ads create mode 100644 src/ortho/mcode/ortho_code-opts.adb create mode 100644 src/ortho/mcode/ortho_code-opts.ads create mode 100644 src/ortho/mcode/ortho_code-types.adb create mode 100644 src/ortho/mcode/ortho_code-types.ads create mode 100644 src/ortho/mcode/ortho_code-x86-abi.adb create mode 100644 src/ortho/mcode/ortho_code-x86-abi.ads create mode 100644 src/ortho/mcode/ortho_code-x86-emits.adb create mode 100644 src/ortho/mcode/ortho_code-x86-emits.ads create mode 100644 src/ortho/mcode/ortho_code-x86-flags_linux.ads create mode 100644 src/ortho/mcode/ortho_code-x86-flags_macosx.ads create mode 100644 src/ortho/mcode/ortho_code-x86-flags_windows.ads create mode 100644 src/ortho/mcode/ortho_code-x86-insns.adb create mode 100644 src/ortho/mcode/ortho_code-x86-insns.ads create mode 100644 src/ortho/mcode/ortho_code-x86.adb create mode 100644 src/ortho/mcode/ortho_code-x86.ads create mode 100644 src/ortho/mcode/ortho_code.ads create mode 100644 src/ortho/mcode/ortho_code_main.adb create mode 100644 src/ortho/mcode/ortho_ident.adb create mode 100644 src/ortho/mcode/ortho_ident.ads create mode 100644 src/ortho/mcode/ortho_jit.adb create mode 100644 src/ortho/mcode/ortho_mcode-jit.adb create mode 100644 src/ortho/mcode/ortho_mcode-jit.ads create mode 100644 src/ortho/mcode/ortho_mcode.adb create mode 100644 src/ortho/mcode/ortho_mcode.ads create mode 100644 src/ortho/mcode/ortho_mcode.private.ads create mode 100644 src/ortho/mcode/ortho_nodes.ads create mode 100644 src/ortho/oread/Makefile create mode 100644 src/ortho/oread/ortho_front.adb create mode 100644 src/ortho/ortho_front.ads create mode 100644 src/ortho/ortho_jit.ads create mode 100644 src/ortho/ortho_nodes.common.ads create mode 100644 src/parse.adb create mode 100644 src/parse.ads create mode 100644 src/parse_psl.adb create mode 100644 src/parse_psl.ads create mode 100644 src/post_sems.adb create mode 100644 src/post_sems.ads create mode 100644 src/psl-errors.ads create mode 100644 src/psl/psl-build.adb create mode 100644 src/psl/psl-build.ads create mode 100644 src/psl/psl-cse.adb create mode 100644 src/psl/psl-cse.ads create mode 100644 src/psl/psl-disp_nfas.adb create mode 100644 src/psl/psl-disp_nfas.ads create mode 100644 src/psl/psl-dump_tree.adb create mode 100644 src/psl/psl-dump_tree.ads create mode 100644 src/psl/psl-hash.adb create mode 100644 src/psl/psl-hash.ads create mode 100644 src/psl/psl-nfas-utils.adb create mode 100644 src/psl/psl-nfas-utils.ads create mode 100644 src/psl/psl-nfas.adb create mode 100644 src/psl/psl-nfas.ads create mode 100644 src/psl/psl-nodes.adb create mode 100644 src/psl/psl-nodes.ads create mode 100644 src/psl/psl-optimize.adb create mode 100644 src/psl/psl-optimize.ads create mode 100644 src/psl/psl-prints.adb create mode 100644 src/psl/psl-prints.ads create mode 100644 src/psl/psl-priorities.ads create mode 100644 src/psl/psl-qm.adb create mode 100644 src/psl/psl-qm.ads create mode 100644 src/psl/psl-rewrites.adb create mode 100644 src/psl/psl-rewrites.ads create mode 100644 src/psl/psl-subsets.adb create mode 100644 src/psl/psl-subsets.ads create mode 100644 src/psl/psl-tprint.adb create mode 100644 src/psl/psl-tprint.ads create mode 100644 src/psl/psl.ads create mode 100644 src/scanner-scan_literal.adb create mode 100644 src/scanner.adb create mode 100644 src/scanner.ads create mode 100644 src/sem.adb create mode 100644 src/sem.ads create mode 100644 src/sem_assocs.adb create mode 100644 src/sem_assocs.ads create mode 100644 src/sem_decls.adb create mode 100644 src/sem_decls.ads create mode 100644 src/sem_expr.adb create mode 100644 src/sem_expr.ads create mode 100644 src/sem_inst.adb create mode 100644 src/sem_inst.ads create mode 100644 src/sem_names.adb create mode 100644 src/sem_names.ads create mode 100644 src/sem_psl.adb create mode 100644 src/sem_psl.ads create mode 100644 src/sem_scopes.adb create mode 100644 src/sem_scopes.ads create mode 100644 src/sem_specs.adb create mode 100644 src/sem_specs.ads create mode 100644 src/sem_stmts.adb create mode 100644 src/sem_stmts.ads create mode 100644 src/sem_types.adb create mode 100644 src/sem_types.ads create mode 100644 src/simulate/annotations.adb create mode 100644 src/simulate/annotations.ads create mode 100644 src/simulate/areapools.adb create mode 100644 src/simulate/areapools.ads create mode 100644 src/simulate/debugger.adb create mode 100644 src/simulate/debugger.ads create mode 100644 src/simulate/elaboration.adb create mode 100644 src/simulate/elaboration.ads create mode 100644 src/simulate/execution.adb create mode 100644 src/simulate/execution.ads create mode 100644 src/simulate/file_operation.adb create mode 100644 src/simulate/file_operation.ads create mode 100644 src/simulate/grt_interface.adb create mode 100644 src/simulate/grt_interface.ads create mode 100644 src/simulate/iir_values.adb create mode 100644 src/simulate/iir_values.ads create mode 100644 src/simulate/sim_be.adb create mode 100644 src/simulate/sim_be.ads create mode 100644 src/simulate/simulation-ams-debugger.adb create mode 100644 src/simulate/simulation-ams-debugger.ads create mode 100644 src/simulate/simulation-ams.adb create mode 100644 src/simulate/simulation-ams.ads create mode 100644 src/simulate/simulation.adb create mode 100644 src/simulate/simulation.ads create mode 100644 src/std_names.adb create mode 100644 src/std_names.ads create mode 100644 src/std_package.adb create mode 100644 src/std_package.ads create mode 100644 src/str_table.adb create mode 100644 src/str_table.ads create mode 100644 src/tokens.adb create mode 100644 src/tokens.ads create mode 100644 src/translate/Makefile create mode 100644 src/translate/gcc/ANNOUNCE create mode 100644 src/translate/gcc/INSTALL create mode 100644 src/translate/gcc/Make-lang.in create mode 100644 src/translate/gcc/Makefile.in create mode 100644 src/translate/gcc/README create mode 100644 src/translate/gcc/config-lang.in create mode 100644 src/translate/gcc/dist-common.sh create mode 100755 src/translate/gcc/dist.sh create mode 100644 src/translate/gcc/lang-options.h create mode 100644 src/translate/gcc/lang-specs.h create mode 100644 src/translate/ghdldrv/Makefile create mode 100644 src/translate/ghdldrv/default_pathes.ads.in create mode 100644 src/translate/ghdldrv/foreigns.adb create mode 100644 src/translate/ghdldrv/foreigns.ads create mode 100644 src/translate/ghdldrv/ghdl_gcc.adb create mode 100644 src/translate/ghdldrv/ghdl_jit.adb create mode 100644 src/translate/ghdldrv/ghdl_simul.adb create mode 100644 src/translate/ghdldrv/ghdlcomp.adb create mode 100644 src/translate/ghdldrv/ghdlcomp.ads create mode 100644 src/translate/ghdldrv/ghdldrv.adb create mode 100644 src/translate/ghdldrv/ghdldrv.ads create mode 100644 src/translate/ghdldrv/ghdllocal.adb create mode 100644 src/translate/ghdldrv/ghdllocal.ads create mode 100644 src/translate/ghdldrv/ghdlmain.adb create mode 100644 src/translate/ghdldrv/ghdlmain.ads create mode 100644 src/translate/ghdldrv/ghdlprint.adb create mode 100644 src/translate/ghdldrv/ghdlprint.ads create mode 100644 src/translate/ghdldrv/ghdlrun.adb create mode 100644 src/translate/ghdldrv/ghdlrun.ads create mode 100644 src/translate/ghdldrv/ghdlsimul.adb create mode 100644 src/translate/ghdldrv/ghdlsimul.ads create mode 100644 src/translate/ghdldrv/grtlink.ads create mode 100644 src/translate/grt/Makefile create mode 100644 src/translate/grt/Makefile.inc create mode 100644 src/translate/grt/config/Makefile create mode 100644 src/translate/grt/config/amd64.S create mode 100644 src/translate/grt/config/chkstk.S create mode 100644 src/translate/grt/config/clock.c create mode 100644 src/translate/grt/config/i386.S create mode 100644 src/translate/grt/config/ia64.S create mode 100644 src/translate/grt/config/linux.c create mode 100644 src/translate/grt/config/ppc.S create mode 100644 src/translate/grt/config/pthread.c create mode 100644 src/translate/grt/config/sparc.S create mode 100644 src/translate/grt/config/teststack.c create mode 100644 src/translate/grt/config/times.c create mode 100644 src/translate/grt/config/win32.c create mode 100644 src/translate/grt/config/win32thr.c create mode 100644 src/translate/grt/ghdl_main.adb create mode 100644 src/translate/grt/ghdl_main.ads create mode 100644 src/translate/grt/ghwdump.c create mode 100644 src/translate/grt/ghwlib.c create mode 100644 src/translate/grt/ghwlib.h create mode 100644 src/translate/grt/grt-arch.ads create mode 100644 src/translate/grt/grt-arch_none.adb create mode 100644 src/translate/grt/grt-arch_none.ads create mode 100644 src/translate/grt/grt-astdio.adb create mode 100644 src/translate/grt/grt-astdio.ads create mode 100644 src/translate/grt/grt-avhpi.adb create mode 100644 src/translate/grt/grt-avhpi.ads create mode 100644 src/translate/grt/grt-avls.adb create mode 100644 src/translate/grt/grt-avls.ads create mode 100644 src/translate/grt/grt-c.ads create mode 100644 src/translate/grt/grt-cbinding.c create mode 100644 src/translate/grt/grt-cvpi.c create mode 100644 src/translate/grt/grt-disp.adb create mode 100644 src/translate/grt/grt-disp.ads create mode 100644 src/translate/grt/grt-disp_rti.adb create mode 100644 src/translate/grt/grt-disp_rti.ads create mode 100644 src/translate/grt/grt-disp_signals.adb create mode 100644 src/translate/grt/grt-disp_signals.ads create mode 100644 src/translate/grt/grt-disp_tree.adb create mode 100644 src/translate/grt/grt-disp_tree.ads create mode 100644 src/translate/grt/grt-errors.adb create mode 100644 src/translate/grt/grt-errors.ads create mode 100644 src/translate/grt/grt-files.adb create mode 100644 src/translate/grt/grt-files.ads create mode 100644 src/translate/grt/grt-hooks.adb create mode 100644 src/translate/grt/grt-hooks.ads create mode 100644 src/translate/grt/grt-images.adb create mode 100644 src/translate/grt/grt-images.ads create mode 100644 src/translate/grt/grt-lib.adb create mode 100644 src/translate/grt/grt-lib.ads create mode 100644 src/translate/grt/grt-main.adb create mode 100644 src/translate/grt/grt-main.ads create mode 100644 src/translate/grt/grt-modules.adb create mode 100644 src/translate/grt/grt-modules.ads create mode 100644 src/translate/grt/grt-names.adb create mode 100644 src/translate/grt/grt-names.ads create mode 100644 src/translate/grt/grt-options.adb create mode 100644 src/translate/grt/grt-options.ads create mode 100644 src/translate/grt/grt-processes.adb create mode 100644 src/translate/grt/grt-processes.ads create mode 100644 src/translate/grt/grt-readline.ads create mode 100644 src/translate/grt/grt-rtis.adb create mode 100644 src/translate/grt/grt-rtis.ads create mode 100644 src/translate/grt/grt-rtis_addr.adb create mode 100644 src/translate/grt/grt-rtis_addr.ads create mode 100644 src/translate/grt/grt-rtis_binding.ads create mode 100644 src/translate/grt/grt-rtis_types.adb create mode 100644 src/translate/grt/grt-rtis_types.ads create mode 100644 src/translate/grt/grt-rtis_utils.adb create mode 100644 src/translate/grt/grt-rtis_utils.ads create mode 100644 src/translate/grt/grt-sdf.adb create mode 100644 src/translate/grt/grt-sdf.ads create mode 100644 src/translate/grt/grt-shadow_ieee.adb create mode 100644 src/translate/grt/grt-shadow_ieee.ads create mode 100644 src/translate/grt/grt-signals.adb create mode 100644 src/translate/grt/grt-signals.ads create mode 100644 src/translate/grt/grt-stack2.adb create mode 100644 src/translate/grt/grt-stack2.ads create mode 100644 src/translate/grt/grt-stacks.adb create mode 100644 src/translate/grt/grt-stacks.ads create mode 100644 src/translate/grt/grt-stats.adb create mode 100644 src/translate/grt/grt-stats.ads create mode 100644 src/translate/grt/grt-std_logic_1164.adb create mode 100644 src/translate/grt/grt-std_logic_1164.ads create mode 100644 src/translate/grt/grt-stdio.ads create mode 100644 src/translate/grt/grt-table.adb create mode 100644 src/translate/grt/grt-table.ads create mode 100644 src/translate/grt/grt-threads.ads create mode 100644 src/translate/grt/grt-types.ads create mode 100644 src/translate/grt/grt-unithread.adb create mode 100644 src/translate/grt/grt-unithread.ads create mode 100644 src/translate/grt/grt-values.adb create mode 100644 src/translate/grt/grt-values.ads create mode 100644 src/translate/grt/grt-vcd.adb create mode 100644 src/translate/grt/grt-vcd.ads create mode 100644 src/translate/grt/grt-vcdz.adb create mode 100644 src/translate/grt/grt-vcdz.ads create mode 100644 src/translate/grt/grt-vital_annotate.adb create mode 100644 src/translate/grt/grt-vital_annotate.ads create mode 100644 src/translate/grt/grt-vpi.adb create mode 100644 src/translate/grt/grt-vpi.ads create mode 100644 src/translate/grt/grt-vstrings.adb create mode 100644 src/translate/grt/grt-vstrings.ads create mode 100644 src/translate/grt/grt-waves.adb create mode 100644 src/translate/grt/grt-waves.ads create mode 100644 src/translate/grt/grt-zlib.ads create mode 100644 src/translate/grt/grt.adc create mode 100644 src/translate/grt/grt.ads create mode 100644 src/translate/grt/grt.ver create mode 100644 src/translate/grt/main.adb create mode 100644 src/translate/grt/main.ads create mode 100644 src/translate/mcode/Makefile.in create mode 100644 src/translate/mcode/README create mode 100755 src/translate/mcode/dist.sh create mode 100644 src/translate/mcode/winbuild.bat create mode 100644 src/translate/mcode/windows/compile.bat create mode 100644 src/translate/mcode/windows/complib.bat create mode 100644 src/translate/mcode/windows/default_pathes.ads create mode 100644 src/translate/mcode/windows/ghdl.nsi create mode 100644 src/translate/mcode/windows/ghdlfilter.adb create mode 100755 src/translate/mcode/windows/ghdlversion.adb create mode 100644 src/translate/mcode/windows/grt-modules.adb create mode 100644 src/translate/mcode/windows/ortho_code-x86-flags.ads create mode 100644 src/translate/mcode/windows/windows_default_path.adb create mode 100644 src/translate/mcode/windows/windows_default_path.ads create mode 100644 src/translate/ortho_front.adb create mode 100644 src/translate/trans_analyzes.adb create mode 100644 src/translate/trans_analyzes.ads create mode 100644 src/translate/trans_be.adb create mode 100644 src/translate/trans_be.ads create mode 100644 src/translate/trans_decls.ads create mode 100644 src/translate/translation.adb create mode 100644 src/translate/translation.ads create mode 100644 src/types.ads create mode 100644 src/version.ads create mode 100644 src/xrefs.adb create mode 100644 src/xrefs.ads create mode 100644 src/xtools/Makefile create mode 100755 src/xtools/pnodes.py delete mode 100644 std_names.adb delete mode 100644 std_names.ads delete mode 100644 std_package.adb delete mode 100644 std_package.ads delete mode 100644 str_table.adb delete mode 100644 str_table.ads delete mode 100644 tokens.adb delete mode 100644 tokens.ads delete mode 100644 translate/Makefile delete mode 100644 translate/gcc/ANNOUNCE delete mode 100644 translate/gcc/INSTALL delete mode 100644 translate/gcc/Make-lang.in delete mode 100644 translate/gcc/Makefile.in delete mode 100644 translate/gcc/README delete mode 100644 translate/gcc/config-lang.in delete mode 100644 translate/gcc/dist-common.sh delete mode 100755 translate/gcc/dist.sh delete mode 100644 translate/gcc/lang-options.h delete mode 100644 translate/gcc/lang-specs.h delete mode 100644 translate/ghdldrv/Makefile delete mode 100644 translate/ghdldrv/default_pathes.ads.in delete mode 100644 translate/ghdldrv/foreigns.adb delete mode 100644 translate/ghdldrv/foreigns.ads delete mode 100644 translate/ghdldrv/ghdl_gcc.adb delete mode 100644 translate/ghdldrv/ghdl_jit.adb delete mode 100644 translate/ghdldrv/ghdl_simul.adb delete mode 100644 translate/ghdldrv/ghdlcomp.adb delete mode 100644 translate/ghdldrv/ghdlcomp.ads delete mode 100644 translate/ghdldrv/ghdldrv.adb delete mode 100644 translate/ghdldrv/ghdldrv.ads delete mode 100644 translate/ghdldrv/ghdllocal.adb delete mode 100644 translate/ghdldrv/ghdllocal.ads delete mode 100644 translate/ghdldrv/ghdlmain.adb delete mode 100644 translate/ghdldrv/ghdlmain.ads delete mode 100644 translate/ghdldrv/ghdlprint.adb delete mode 100644 translate/ghdldrv/ghdlprint.ads delete mode 100644 translate/ghdldrv/ghdlrun.adb delete mode 100644 translate/ghdldrv/ghdlrun.ads delete mode 100644 translate/ghdldrv/ghdlsimul.adb delete mode 100644 translate/ghdldrv/ghdlsimul.ads delete mode 100644 translate/ghdldrv/grtlink.ads delete mode 100644 translate/grt/Makefile delete mode 100644 translate/grt/Makefile.inc delete mode 100644 translate/grt/config/Makefile delete mode 100644 translate/grt/config/amd64.S delete mode 100644 translate/grt/config/chkstk.S delete mode 100644 translate/grt/config/clock.c delete mode 100644 translate/grt/config/i386.S delete mode 100644 translate/grt/config/ia64.S delete mode 100644 translate/grt/config/linux.c delete mode 100644 translate/grt/config/ppc.S delete mode 100644 translate/grt/config/pthread.c delete mode 100644 translate/grt/config/sparc.S delete mode 100644 translate/grt/config/teststack.c delete mode 100644 translate/grt/config/times.c delete mode 100644 translate/grt/config/win32.c delete mode 100644 translate/grt/config/win32thr.c delete mode 100644 translate/grt/ghdl_main.adb delete mode 100644 translate/grt/ghdl_main.ads delete mode 100644 translate/grt/ghwdump.c delete mode 100644 translate/grt/ghwlib.c delete mode 100644 translate/grt/ghwlib.h delete mode 100644 translate/grt/grt-arch.ads delete mode 100644 translate/grt/grt-arch_none.adb delete mode 100644 translate/grt/grt-arch_none.ads delete mode 100644 translate/grt/grt-astdio.adb delete mode 100644 translate/grt/grt-astdio.ads delete mode 100644 translate/grt/grt-avhpi.adb delete mode 100644 translate/grt/grt-avhpi.ads delete mode 100644 translate/grt/grt-avls.adb delete mode 100644 translate/grt/grt-avls.ads delete mode 100644 translate/grt/grt-c.ads delete mode 100644 translate/grt/grt-cbinding.c delete mode 100644 translate/grt/grt-cvpi.c delete mode 100644 translate/grt/grt-disp.adb delete mode 100644 translate/grt/grt-disp.ads delete mode 100644 translate/grt/grt-disp_rti.adb delete mode 100644 translate/grt/grt-disp_rti.ads delete mode 100644 translate/grt/grt-disp_signals.adb delete mode 100644 translate/grt/grt-disp_signals.ads delete mode 100644 translate/grt/grt-disp_tree.adb delete mode 100644 translate/grt/grt-disp_tree.ads delete mode 100644 translate/grt/grt-errors.adb delete mode 100644 translate/grt/grt-errors.ads delete mode 100644 translate/grt/grt-files.adb delete mode 100644 translate/grt/grt-files.ads delete mode 100644 translate/grt/grt-hooks.adb delete mode 100644 translate/grt/grt-hooks.ads delete mode 100644 translate/grt/grt-images.adb delete mode 100644 translate/grt/grt-images.ads delete mode 100644 translate/grt/grt-lib.adb delete mode 100644 translate/grt/grt-lib.ads delete mode 100644 translate/grt/grt-main.adb delete mode 100644 translate/grt/grt-main.ads delete mode 100644 translate/grt/grt-modules.adb delete mode 100644 translate/grt/grt-modules.ads delete mode 100644 translate/grt/grt-names.adb delete mode 100644 translate/grt/grt-names.ads delete mode 100644 translate/grt/grt-options.adb delete mode 100644 translate/grt/grt-options.ads delete mode 100644 translate/grt/grt-processes.adb delete mode 100644 translate/grt/grt-processes.ads delete mode 100644 translate/grt/grt-readline.ads delete mode 100644 translate/grt/grt-rtis.adb delete mode 100644 translate/grt/grt-rtis.ads delete mode 100644 translate/grt/grt-rtis_addr.adb delete mode 100644 translate/grt/grt-rtis_addr.ads delete mode 100644 translate/grt/grt-rtis_binding.ads delete mode 100644 translate/grt/grt-rtis_types.adb delete mode 100644 translate/grt/grt-rtis_types.ads delete mode 100644 translate/grt/grt-rtis_utils.adb delete mode 100644 translate/grt/grt-rtis_utils.ads delete mode 100644 translate/grt/grt-sdf.adb delete mode 100644 translate/grt/grt-sdf.ads delete mode 100644 translate/grt/grt-shadow_ieee.adb delete mode 100644 translate/grt/grt-shadow_ieee.ads delete mode 100644 translate/grt/grt-signals.adb delete mode 100644 translate/grt/grt-signals.ads delete mode 100644 translate/grt/grt-stack2.adb delete mode 100644 translate/grt/grt-stack2.ads delete mode 100644 translate/grt/grt-stacks.adb delete mode 100644 translate/grt/grt-stacks.ads delete mode 100644 translate/grt/grt-stats.adb delete mode 100644 translate/grt/grt-stats.ads delete mode 100644 translate/grt/grt-std_logic_1164.adb delete mode 100644 translate/grt/grt-std_logic_1164.ads delete mode 100644 translate/grt/grt-stdio.ads delete mode 100644 translate/grt/grt-table.adb delete mode 100644 translate/grt/grt-table.ads delete mode 100644 translate/grt/grt-threads.ads delete mode 100644 translate/grt/grt-types.ads delete mode 100644 translate/grt/grt-unithread.adb delete mode 100644 translate/grt/grt-unithread.ads delete mode 100644 translate/grt/grt-values.adb delete mode 100644 translate/grt/grt-values.ads delete mode 100644 translate/grt/grt-vcd.adb delete mode 100644 translate/grt/grt-vcd.ads delete mode 100644 translate/grt/grt-vcdz.adb delete mode 100644 translate/grt/grt-vcdz.ads delete mode 100644 translate/grt/grt-vital_annotate.adb delete mode 100644 translate/grt/grt-vital_annotate.ads delete mode 100644 translate/grt/grt-vpi.adb delete mode 100644 translate/grt/grt-vpi.ads delete mode 100644 translate/grt/grt-vstrings.adb delete mode 100644 translate/grt/grt-vstrings.ads delete mode 100644 translate/grt/grt-waves.adb delete mode 100644 translate/grt/grt-waves.ads delete mode 100644 translate/grt/grt-zlib.ads delete mode 100644 translate/grt/grt.adc delete mode 100644 translate/grt/grt.ads delete mode 100644 translate/grt/grt.ver delete mode 100644 translate/grt/main.adb delete mode 100644 translate/grt/main.ads delete mode 100644 translate/mcode/Makefile.in delete mode 100644 translate/mcode/README delete mode 100755 translate/mcode/dist.sh delete mode 100644 translate/mcode/winbuild.bat delete mode 100644 translate/mcode/windows/compile.bat delete mode 100644 translate/mcode/windows/complib.bat delete mode 100644 translate/mcode/windows/default_pathes.ads delete mode 100644 translate/mcode/windows/ghdl.nsi delete mode 100644 translate/mcode/windows/ghdlfilter.adb delete mode 100755 translate/mcode/windows/ghdlversion.adb delete mode 100644 translate/mcode/windows/grt-modules.adb delete mode 100644 translate/mcode/windows/ortho_code-x86-flags.ads delete mode 100644 translate/mcode/windows/windows_default_path.adb delete mode 100644 translate/mcode/windows/windows_default_path.ads delete mode 100644 translate/ortho_front.adb delete mode 100644 translate/trans_analyzes.adb delete mode 100644 translate/trans_analyzes.ads delete mode 100644 translate/trans_be.adb delete mode 100644 translate/trans_be.ads delete mode 100644 translate/trans_decls.ads delete mode 100644 translate/translation.adb delete mode 100644 translate/translation.ads delete mode 100644 types.ads delete mode 100644 version.ads delete mode 100644 xrefs.adb delete mode 100644 xrefs.ads delete mode 100644 xtools/Makefile delete mode 100755 xtools/pnodes.py diff --git a/back_end.adb b/back_end.adb deleted file mode 100644 index 81bc20732..000000000 --- a/back_end.adb +++ /dev/null @@ -1,38 +0,0 @@ --- Back-end specialization --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Flags; use Flags; -with Iirs_Utils; use Iirs_Utils; - -package body Back_End is - -- Transform a library identifier into a file name. - -- Very simple mechanism: just add '-simVV.cf' extension, where VV - -- is the version. - function Default_Library_To_File_Name (Library: Iir_Library_Declaration) - return String - is - begin - case Vhdl_Std is - when Vhdl_87 => - return Image_Identifier (Library) & "-obj87.cf"; - when Vhdl_93c | Vhdl_93 | Vhdl_00 | Vhdl_02 => - return Image_Identifier (Library) & "-obj93.cf"; - when Vhdl_08 => - return Image_Identifier (Library) & "-obj08.cf"; - end case; - end Default_Library_To_File_Name; -end Back_End; diff --git a/back_end.ads b/back_end.ads deleted file mode 100644 index 3ee1e686a..000000000 --- a/back_end.ads +++ /dev/null @@ -1,57 +0,0 @@ --- Back-end specialization --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Iirs; use Iirs; - -package Back_End is - -- Return the name of the library file for LIBRARY. - -- The library file describe the contents of LIBRARY. - function Default_Library_To_File_Name (Library : Iir_Library_Declaration) - return String; - - type Library_To_File_Name_Acc is - access function (Library : Iir_Library_Declaration) return String; - - Library_To_File_Name : Library_To_File_Name_Acc := - Default_Library_To_File_Name'Access; - - -- Back-end options. - type Parse_Option_Acc is access function (Opt : String) return Boolean; - Parse_Option : Parse_Option_Acc := null; - - -- Disp back-end option help. - type Disp_Option_Acc is access procedure; - Disp_Option : Disp_Option_Acc := null; - - -- UNIT is a design unit from parse. - -- According to the current back-end, do what is necessary. - -- - -- If MAIN is true, then UNIT is a wanted to be analysed design unit, and - -- dump/list options can applied. - -- This avoid to dump/list units fetched (through a selected name or a - -- use clause) indirectly by the main unit. - type Finish_Compilation_Acc is access - procedure (Unit : Iir_Design_Unit; Main : Boolean := False); - - Finish_Compilation : Finish_Compilation_Acc := null; - - -- DECL is an architecture (library unit) or a subprogram (specification) - -- decorated with a FOREIGN attribute. Do back-end checks. - -- May be NULL for no additionnal checks. - type Sem_Foreign_Acc is access procedure (Decl : Iir); - Sem_Foreign : Sem_Foreign_Acc := null; -end Back_End; diff --git a/bug.adb b/bug.adb deleted file mode 100644 index 0948b97ff..000000000 --- a/bug.adb +++ /dev/null @@ -1,104 +0,0 @@ --- Bug handling --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Ada.Text_IO; use Ada.Text_IO; -with Ada.Command_Line; use Ada.Command_Line; -with GNAT.Directory_Operations; -with Version; use Version; - -package body Bug is - -- Declared in the files generated by gnatbind. - -- Note: since the string is exported with C convension, there is no way - -- to know the length (gnat1 crashes if the string is unconstrained). - -- Hopefully, the format of the string seems to be fixed. - -- We don't use GNAT.Compiler_Version because it doesn't exist - -- in gnat 3.15p - GNAT_Version : constant String (1 .. 31 + 15); - pragma Import (C, GNAT_Version, "__gnat_version"); - - function Get_Gnat_Version return String - is - C : Character; - begin - for I in GNAT_Version'Range loop - C := GNAT_Version (I); - case C is - when ' ' - | 'A' .. 'Z' - | 'a' .. 'z' - | '0' .. '9' - | ':' - | '-' - | '.' - | '(' => - -- Accept only a few printable characters. - -- Underscore is excluded since the next bytes after - -- GNAT_Version is Ada_Main_Program_Name, which often starts - -- with _ada_. - null; - when ')' => - return GNAT_Version (1 .. I); - when others => - return GNAT_Version (1 .. I - 1); - end case; - end loop; - return GNAT_Version; - end Get_Gnat_Version; - - procedure Disp_Bug_Box (Except : Exception_Occurrence) - is - Id : Exception_Id; - begin - New_Line (Standard_Error); - Put_Line - (Standard_Error, - "******************** GHDL Bug occured ****************************"); - Put_Line - (Standard_Error, - "Please report this bug on http://gna.org/projects/ghdl"); - Put_Line (Standard_Error, "GHDL release: " & Ghdl_Release); - Put_Line (Standard_Error, "Compiled with " & Get_Gnat_Version); - Put_Line (Standard_Error, "In directory: " & - GNAT.Directory_Operations.Get_Current_Dir); - --Put_Line - -- ("Program name: " & Command_Name); - --Put_Line - -- ("Program arguments:"); - --for I in 1 .. Argument_Count loop - -- Put_Line (" " & Argument (I)); - --end loop; - Put_Line (Standard_Error, "Command line:"); - Put (Standard_Error, Command_Name); - for I in 1 .. Argument_Count loop - Put (Standard_Error, ' '); - Put (Standard_Error, Argument (I)); - end loop; - New_Line (Standard_Error); - Id := Exception_Identity (Except); - if Id /= Null_Id then - Put_Line (Standard_Error, - "Exception " & Exception_Name (Id) & " raised"); - --Put_Line ("exception message: " & Exception_Message (Except)); - Put_Line (Standard_Error, - "Exception information:"); - Put (Standard_Error, Exception_Information (Except)); - end if; - Put_Line - (Standard_Error, - "******************************************************************"); - end Disp_Bug_Box; -end Bug; diff --git a/bug.ads b/bug.ads deleted file mode 100644 index c90ca0976..000000000 --- a/bug.ads +++ /dev/null @@ -1,26 +0,0 @@ --- Bug handling --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Ada.Exceptions; use Ada.Exceptions; - -package Bug is - -- Display a bug box for EXCEPT. - procedure Disp_Bug_Box (Except : Exception_Occurrence); - - -- Get the gnat version used to bind the unit. - function Get_Gnat_Version return String; -end Bug; diff --git a/canon.adb b/canon.adb deleted file mode 100644 index cd2dae0fd..000000000 --- a/canon.adb +++ /dev/null @@ -1,2735 +0,0 @@ --- Canonicalization pass --- Copyright (C) 2002, 2003, 2004, 2005, 2008 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Errorout; use Errorout; -with Iirs_Utils; use Iirs_Utils; -with Types; use Types; -with Name_Table; -with Sem; -with Iir_Chains; use Iir_Chains; -with Flags; use Flags; -with PSL.Nodes; -with PSL.Rewrites; -with PSL.Build; - -package body Canon is - -- Canonicalize a list of declarations. LIST can be null. - -- PARENT must be the parent of the current statements chain for LIST, - -- or NULL_IIR if LIST has no corresponding current statments. - procedure Canon_Declarations (Top : Iir_Design_Unit; - Decl_Parent : Iir; - Parent : Iir); - procedure Canon_Declaration (Top : Iir_Design_Unit; - Decl : Iir; - Parent : Iir; - Decl_Parent : Iir); - - -- Canon on expressions, mainly for function calls. - procedure Canon_Expression (Expr: Iir); - - -- Canonicalize an association list. - -- If ASSOCIATION_LIST is not null, then it is re-ordored and returned. - -- If ASSOCIATION_LIST is null then: - -- if INTERFACE_LIST is null then returns null. - -- if INTERFACE_LIST is not null, a default list is created. - function Canon_Association_Chain - (Interface_Chain: Iir; Association_Chain: Iir; Loc : Iir) - return Iir; - - -- Like Canon_Association_Chain but recurse on actuals. - function Canon_Association_Chain_And_Actuals - (Interface_Chain: Iir; Association_Chain: Iir; Loc : Iir) - return Iir; - - -- Like Canon_Subprogram_Call, but recurse on actuals. - procedure Canon_Subprogram_Call_And_Actuals (Call : Iir); - - -- Canonicalize block configuration CONF. - -- TOP is used to added dependences to the design unit which CONF - -- belongs to. - procedure Canon_Block_Configuration (Top : Iir_Design_Unit; - Conf : Iir_Block_Configuration); - - procedure Canon_Subtype_Indication (Def : Iir); - procedure Canon_Subtype_Indication_If_Anonymous (Def : Iir); - - procedure Canon_Extract_Sensitivity_Aggregate - (Aggr : Iir; - Sensitivity_List : Iir_List; - Is_Target : Boolean; - Aggr_Type : Iir; - Dim : Natural) - is - Assoc : Iir; - begin - Assoc := Get_Association_Choices_Chain (Aggr); - if Get_Nbr_Elements (Get_Index_Subtype_List (Aggr_Type)) = Dim then - while Assoc /= Null_Iir loop - Canon_Extract_Sensitivity - (Get_Associated_Expr (Assoc), Sensitivity_List, Is_Target); - Assoc := Get_Chain (Assoc); - end loop; - else - while Assoc /= Null_Iir loop - Canon_Extract_Sensitivity_Aggregate - (Get_Associated_Expr (Assoc), Sensitivity_List, - Is_Target, Aggr_Type, Dim + 1); - Assoc := Get_Chain (Assoc); - end loop; - end if; - end Canon_Extract_Sensitivity_Aggregate; - - procedure Canon_Extract_Sensitivity - (Expr: Iir; Sensitivity_List: Iir_List; Is_Target: Boolean := False) - is - El : Iir; - List: Iir_List; - begin - if Get_Expr_Staticness (Expr) /= None then - return; - end if; - - case Get_Kind (Expr) is - when Iir_Kind_Slice_Name => - if not Is_Target and then - Get_Name_Staticness (Expr) >= Globally - then - if Is_Signal_Object (Expr) then - Add_Element (Sensitivity_List, Expr); - end if; - else - declare - Suff : Iir; - begin - Canon_Extract_Sensitivity - (Get_Prefix (Expr), Sensitivity_List, Is_Target); - Suff := Get_Suffix (Expr); - if Get_Kind (Suff) not in Iir_Kinds_Scalar_Type_Definition - then - Canon_Extract_Sensitivity - (Suff, Sensitivity_List, False); - end if; - end; - end if; - - when Iir_Kind_Selected_Element => - if not Is_Target and then - Get_Name_Staticness (Expr) >= Globally - then - if Is_Signal_Object (Expr) then - Add_Element (Sensitivity_List, Expr); - end if; - else - Canon_Extract_Sensitivity (Get_Prefix (Expr), - Sensitivity_List, - Is_Target); - end if; - - when Iir_Kind_Indexed_Name => - if not Is_Target - and then Get_Name_Staticness (Expr) >= Globally - then - if Is_Signal_Object (Expr) then - Add_Element (Sensitivity_List, Expr); - end if; - else - Canon_Extract_Sensitivity (Get_Prefix (Expr), - Sensitivity_List, - Is_Target); - List := Get_Index_List (Expr); - for I in Natural loop - El := Get_Nth_Element (List, I); - exit when El = Null_Iir; - Canon_Extract_Sensitivity (El, Sensitivity_List, False); - end loop; - end if; - - when Iir_Kind_Function_Call => - El := Get_Parameter_Association_Chain (Expr); - while El /= Null_Iir loop - case Get_Kind (El) is - when Iir_Kind_Association_Element_By_Expression => - Canon_Extract_Sensitivity - (Get_Actual (El), Sensitivity_List, False); - when Iir_Kind_Association_Element_Open => - null; - when others => - Error_Kind ("canon_extract_sensitivity(call)", El); - end case; - El := Get_Chain (El); - end loop; - - when Iir_Kind_Qualified_Expression - | Iir_Kind_Type_Conversion - | Iir_Kind_Allocator_By_Expression => - Canon_Extract_Sensitivity - (Get_Expression (Expr), Sensitivity_List, False); - - when Iir_Kind_Allocator_By_Subtype => - null; - - when Iir_Kinds_Monadic_Operator => - Canon_Extract_Sensitivity - (Get_Operand (Expr), Sensitivity_List, False); - when Iir_Kinds_Dyadic_Operator => - Canon_Extract_Sensitivity - (Get_Left (Expr), Sensitivity_List, False); - Canon_Extract_Sensitivity - (Get_Right (Expr), Sensitivity_List, False); - - when Iir_Kind_Range_Expression => - Canon_Extract_Sensitivity - (Get_Left_Limit (Expr), Sensitivity_List, False); - Canon_Extract_Sensitivity - (Get_Right_Limit (Expr), Sensitivity_List, False); - - when Iir_Kinds_Type_Attribute => - null; - when Iir_Kind_Event_Attribute - | Iir_Kind_Active_Attribute => - -- LRM 8.1 - -- An attribute name: [...]; otherwise, apply this rule to the - -- prefix of the attribute name. - Canon_Extract_Sensitivity - (Get_Prefix (Expr), Sensitivity_List, False); - - - when Iir_Kind_Last_Value_Attribute => - null; - - when Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Stable_Attribute - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute => - -- LRM 8.1 - -- A simple name that denotes a signal, add the longuest static - -- prefix of the name to the sensitivity set; - -- - -- An attribute name: if the designator denotes a signal - -- attribute, add the longuest static prefix of the name of the - -- implicit signal denoted by the attribute name to the - -- sensitivity set; [...] - if not Is_Target then - Add_Element (Sensitivity_List, Expr); - end if; - - when Iir_Kind_Object_Alias_Declaration => - Canon_Extract_Sensitivity - (Get_Name (Expr), Sensitivity_List, Is_Target); - - when Iir_Kind_Constant_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_File_Declaration => - null; - - when Iir_Kinds_Array_Attribute => - -- was Iir_Kind_Left_Array_Attribute - -- ditto Right, Low, High, Length - -- add Ascending, Range and Reverse_Range... - null; - --Canon_Extract_Sensitivity - -- (Get_Prefix (Expr), Sensitivity_List, Is_Target); - - when Iir_Kind_Value_Attribute - | Iir_Kind_Image_Attribute - | Iir_Kinds_Scalar_Type_Attribute => - Canon_Extract_Sensitivity - (Get_Parameter (Expr), Sensitivity_List, Is_Target); - - when Iir_Kind_Aggregate => - declare - Aggr_Type : Iir; - begin - Aggr_Type := Get_Base_Type (Get_Type (Expr)); - case Get_Kind (Aggr_Type) is - when Iir_Kind_Array_Type_Definition => - Canon_Extract_Sensitivity_Aggregate - (Expr, Sensitivity_List, Is_Target, Aggr_Type, 1); - when Iir_Kind_Record_Type_Definition => - El := Get_Association_Choices_Chain (Expr); - while El /= Null_Iir loop - Canon_Extract_Sensitivity - (Get_Associated_Expr (El), Sensitivity_List, - Is_Target); - El := Get_Chain (El); - end loop; - when others => - Error_Kind ("canon_extract_sensitivity(aggr)", Aggr_Type); - end case; - end; - - when Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name => - Canon_Extract_Sensitivity - (Get_Named_Entity (Expr), Sensitivity_List, Is_Target); - - when others => - Error_Kind ("canon_extract_sensitivity", Expr); - end case; - end Canon_Extract_Sensitivity; - - procedure Canon_Extract_Sensitivity_If_Not_Null - (Expr: Iir; Sensitivity_List: Iir_List; Is_Target: Boolean := False) is - begin - if Expr /= Null_Iir then - Canon_Extract_Sensitivity (Expr, Sensitivity_List, Is_Target); - end if; - end Canon_Extract_Sensitivity_If_Not_Null; - - procedure Canon_Extract_Sequential_Statement_Chain_Sensitivity - (Chain : Iir; List : Iir_List) - is - Stmt : Iir; - begin - Stmt := Chain; - while Stmt /= Null_Iir loop - case Get_Kind (Stmt) is - when Iir_Kind_Assertion_Statement => - -- LRM08 11.3 - -- * For each assertion, report, next, exit or return - -- statement, apply the rule of 10.2 to each expression - -- in the statement, and construct the union of the - -- resulting sets. - Canon_Extract_Sensitivity - (Get_Assertion_Condition (Stmt), List); - Canon_Extract_Sensitivity - (Get_Severity_Expression (Stmt), List); - Canon_Extract_Sensitivity - (Get_Report_Expression (Stmt), List); - when Iir_Kind_Report_Statement => - -- LRM08 11.3 - -- See assertion_statement case. - Canon_Extract_Sensitivity - (Get_Severity_Expression (Stmt), List); - Canon_Extract_Sensitivity - (Get_Report_Expression (Stmt), List); - when Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement => - -- LRM08 11.3 - -- See assertion_statement case. - Canon_Extract_Sensitivity - (Get_Condition (Stmt), List); - when Iir_Kind_Return_Statement => - -- LRM08 11.3 - -- See assertion_statement case. - Canon_Extract_Sensitivity_If_Not_Null - (Get_Expression (Stmt), List); - when Iir_Kind_Variable_Assignment_Statement => - -- LRM08 11.3 - -- * For each assignment statement, apply the rule of 10.2 to - -- each expression occuring in the assignment, including any - -- expressions occuring in the index names or slice names in - -- the target, and construct the union of the resulting sets. - Canon_Extract_Sensitivity (Get_Target (Stmt), List, True); - Canon_Extract_Sensitivity (Get_Expression (Stmt), List, False); - when Iir_Kind_Signal_Assignment_Statement => - -- LRM08 11.3 - -- See variable assignment statement case. - Canon_Extract_Sensitivity (Get_Target (Stmt), List, True); - Canon_Extract_Sensitivity_If_Not_Null - (Get_Reject_Time_Expression (Stmt), List); - declare - We: Iir_Waveform_Element; - begin - We := Get_Waveform_Chain (Stmt); - while We /= Null_Iir loop - Canon_Extract_Sensitivity (Get_We_Value (We), List); - We := Get_Chain (We); - end loop; - end; - when Iir_Kind_If_Statement => - -- LRM08 11.3 - -- * For each if statement, apply the rule of 10.2 to the - -- condition and apply this rule recursively to each - -- sequence of statements within the if statement, and - -- construct the union of the resuling sets. - declare - El1 : Iir := Stmt; - Cond : Iir; - begin - loop - Cond := Get_Condition (El1); - if Cond /= Null_Iir then - Canon_Extract_Sensitivity (Cond, List); - end if; - Canon_Extract_Sequential_Statement_Chain_Sensitivity - (Get_Sequential_Statement_Chain (El1), List); - El1 := Get_Else_Clause (El1); - exit when El1 = Null_Iir; - end loop; - end; - when Iir_Kind_Case_Statement => - -- LRM08 11.3 - -- * For each case statement, apply the rule of 10.2 to the - -- expression and apply this rule recursively to each - -- sequence of statements within the case statement, and - -- construct the union of the resulting sets. - Canon_Extract_Sensitivity (Get_Expression (Stmt), List); - declare - Choice: Iir; - begin - Choice := Get_Case_Statement_Alternative_Chain (Stmt); - while Choice /= Null_Iir loop - Canon_Extract_Sequential_Statement_Chain_Sensitivity - (Get_Associated_Chain (Choice), List); - Choice := Get_Chain (Choice); - end loop; - end; - when Iir_Kind_While_Loop_Statement => - -- LRM08 11.3 - -- * For each loop statement, apply the rule of 10.2 to each - -- expression in the iteration scheme, if present, and apply - -- this rule recursively to the sequence of statements within - -- the loop statement, and construct the union of the - -- resulting sets. - Canon_Extract_Sensitivity_If_Not_Null - (Get_Condition (Stmt), List); - Canon_Extract_Sequential_Statement_Chain_Sensitivity - (Get_Sequential_Statement_Chain (Stmt), List); - when Iir_Kind_For_Loop_Statement => - -- LRM08 11.3 - -- See loop statement case. - declare - It : constant Iir := Get_Parameter_Specification (Stmt); - It_Type : constant Iir := Get_Type (It); - Rng : constant Iir := Get_Range_Constraint (It_Type); - begin - if Get_Kind (Rng) = Iir_Kind_Range_Expression then - Canon_Extract_Sensitivity (Rng, List); - end if; - end; - Canon_Extract_Sequential_Statement_Chain_Sensitivity - (Get_Sequential_Statement_Chain (Stmt), List); - when Iir_Kind_Null_Statement => - -- LRM08 11.3 - -- ? - null; - when Iir_Kind_Procedure_Call_Statement => - -- LRM08 11.3 - -- * For each procedure call statement, apply the rule of 10.2 - -- to each actual designator (other than OPEN) associated - -- with each formal parameter of mode IN or INOUT, and - -- construct the union of the resulting sets. - declare - Param : Iir; - begin - Param := Get_Parameter_Association_Chain - (Get_Procedure_Call (Stmt)); - while Param /= Null_Iir loop - if (Get_Kind (Param) - = Iir_Kind_Association_Element_By_Expression) - and then (Get_Mode (Get_Association_Interface (Param)) - /= Iir_Out_Mode) - then - Canon_Extract_Sensitivity (Get_Actual (Param), List); - end if; - Param := Get_Chain (Param); - end loop; - end; - when others => - Error_Kind - ("canon_extract_sequential_statement_chain_sensitivity", - Stmt); - end case; - Stmt := Get_Chain (Stmt); - end loop; - end Canon_Extract_Sequential_Statement_Chain_Sensitivity; - - procedure Canon_Extract_Sensitivity_From_Callees - (Callees_List : Iir_List; Sensitivity_List : Iir_List) - is - Callee : Iir; - Bod : Iir; - begin - -- LRM08 11.3 - -- Moreover, for each subprogram for which the process is a parent - -- (see 4.3), the sensitivity list includes members of the set - -- constructed by apply the preceding rule to the statements of the - -- subprogram, but excluding the members that denote formal signal - -- parameters or members of formal signal parameters of the subprogram - -- or any of its parents. - if Callees_List = Null_Iir_List then - return; - end if; - for I in Natural loop - Callee := Get_Nth_Element (Callees_List, I); - exit when Callee = Null_Iir; - if not Get_Seen_Flag (Callee) then - Set_Seen_Flag (Callee, True); - case Get_All_Sensitized_State (Callee) is - when Read_Signal => - Bod := Get_Subprogram_Body (Callee); - - -- Extract sensitivity from signals read in the body. - -- FIXME: what about signals read during in declarations ? - Canon_Extract_Sequential_Statement_Chain_Sensitivity - (Get_Sequential_Statement_Chain (Bod), Sensitivity_List); - - -- Extract sensitivity from subprograms called. - Canon_Extract_Sensitivity_From_Callees - (Get_Callees_List (Bod), Sensitivity_List); - - when No_Signal => - null; - - when Unknown | Invalid_Signal => - raise Internal_Error; - end case; - end if; - end loop; - end Canon_Extract_Sensitivity_From_Callees; - - function Canon_Extract_Process_Sensitivity - (Proc : Iir_Sensitized_Process_Statement) - return Iir_List - is - Res : Iir_List; - begin - Res := Create_Iir_List; - - -- Signals read by statements. - -- FIXME: justify why signals read in declarations don't care. - Canon_Extract_Sequential_Statement_Chain_Sensitivity - (Get_Sequential_Statement_Chain (Proc), Res); - - -- Signals read indirectly by subprograms called. - Canon_Extract_Sensitivity_From_Callees (Get_Callees_List (Proc), Res); - - Set_Seen_Flag (Proc, True); - Clear_Seen_Flag (Proc); - return Res; - end Canon_Extract_Process_Sensitivity; - --- function Make_Aggregate (Array_Type : Iir_Array_Type_Definition; El : Iir) --- return Iir_Aggregate --- is --- Res : Iir_Aggregate; --- Choice : Iir; --- begin --- Res := Create_Iir (Iir_Kind_Aggregate); --- Location_Copy (Res, El); --- Choice := Create_Iir (Iir_Kind_Association_Choice_By_None); --- Set_Associated (Choice, El); --- Append_Element (Get_Association_Choices_List (Res), Choice); - --- -- will call sem_aggregate --- return Sem_Expr.Sem_Expression (Res, Array_Type); --- end Make_Aggregate; - --- procedure Canon_Concatenation_Operator (Expr : Iir) --- is --- Array_Type : Iir_Array_Type_Definition; --- El_Type : Iir; --- Left, Right : Iir; --- Func_List : Iir_Implicit_Functions_List; --- Func : Iir_Implicit_Function_Declaration; --- begin --- Array_Type := Get_Type (Expr); --- El_Type := Get_Base_Type (Get_Element_Subtype (Array_Type)); --- Left := Get_Left (Expr); --- if Get_Type (Left) = El_Type then --- Set_Left (Expr, Make_Aggregate (Array_Type, Left)); --- end if; --- Right := Get_Right (Expr); --- if Get_Type (Right) = El_Type then --- Set_Right (Expr, Make_Aggregate (Array_Type, Right)); --- end if; - --- -- FIXME: must convert the implementation. --- -- Use implicit declaration list from the array_type ? --- Func_List := Get_Implicit_Functions_List --- (Get_Type_Declarator (Array_Type)); --- for I in Natural loop --- Func := Get_Nth_Element (Func_List, I); --- if Get_Implicit_Definition (Func) --- = Iir_Predefined_Array_Array_Concat --- then --- Set_Implementation (Expr, Func); --- exit; --- end if; --- end loop; --- end Canon_Concatenation_Operator; - - procedure Canon_Aggregate_Expression (Expr: Iir) - is - Assoc : Iir; - begin - Assoc := Get_Association_Choices_Chain (Expr); - while Assoc /= Null_Iir loop - case Get_Kind (Assoc) is - when Iir_Kind_Choice_By_Others - | Iir_Kind_Choice_By_None - | Iir_Kind_Choice_By_Name => - null; - when Iir_Kind_Choice_By_Expression => - Canon_Expression (Get_Choice_Expression (Assoc)); - when Iir_Kind_Choice_By_Range => - declare - Choice : constant Iir := Get_Choice_Range (Assoc); - begin - if Get_Kind (Choice) = Iir_Kind_Range_Expression then - Canon_Expression (Choice); - end if; - end; - when others => - Error_Kind ("canon_aggregate_expression", Assoc); - end case; - Canon_Expression (Get_Associated_Expr (Assoc)); - Assoc := Get_Chain (Assoc); - end loop; - end Canon_Aggregate_Expression; - - -- canon on expressions, mainly for function calls. - procedure Canon_Expression (Expr: Iir) - is - El : Iir; - List: Iir_List; - begin - if Expr = Null_Iir then - return; - end if; - case Get_Kind (Expr) is - when Iir_Kind_Range_Expression => - Canon_Expression (Get_Left_Limit (Expr)); - Canon_Expression (Get_Right_Limit (Expr)); - - when Iir_Kind_Slice_Name => - declare - Suffix : Iir; - begin - Suffix := Get_Suffix (Expr); - if Get_Kind (Suffix) not in Iir_Kinds_Discrete_Type_Definition - then - Canon_Expression (Suffix); - end if; - Canon_Expression (Get_Prefix (Expr)); - end; - - when Iir_Kind_Indexed_Name => - Canon_Expression (Get_Prefix (Expr)); - List := Get_Index_List (Expr); - for I in Natural loop - El := Get_Nth_Element (List, I); - exit when El = Null_Iir; - Canon_Expression (El); - end loop; - - when Iir_Kind_Selected_Element => - Canon_Expression (Get_Prefix (Expr)); - when Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference => - Canon_Expression (Get_Prefix (Expr)); - - when Iir_Kinds_Denoting_Name => - Canon_Expression (Get_Named_Entity (Expr)); - - when Iir_Kinds_Monadic_Operator => - Canon_Expression (Get_Operand (Expr)); - when Iir_Kinds_Dyadic_Operator => - Canon_Expression (Get_Left (Expr)); - Canon_Expression (Get_Right (Expr)); - if Get_Kind (Expr) = Iir_Kind_Concatenation_Operator - and then Canon_Concatenation - and then Get_Kind (Get_Implementation (Expr)) = - Iir_Kind_Implicit_Function_Declaration - then - --Canon_Concatenation_Operator (Expr); - raise Internal_Error; - end if; - - when Iir_Kind_Function_Call => - Canon_Subprogram_Call_And_Actuals (Expr); - -- FIXME: - -- should canon concatenation. - - when Iir_Kind_Parenthesis_Expression => - Canon_Expression (Get_Expression (Expr)); - when Iir_Kind_Type_Conversion - | Iir_Kind_Qualified_Expression => - Canon_Expression (Get_Expression (Expr)); - when Iir_Kind_Aggregate => - Canon_Aggregate_Expression (Expr); - when Iir_Kind_Allocator_By_Expression => - Canon_Expression (Get_Expression (Expr)); - when Iir_Kind_Allocator_By_Subtype => - declare - Ind : constant Iir := Get_Subtype_Indication (Expr); - begin - if Get_Kind (Ind) = Iir_Kind_Array_Subtype_Definition then - Canon_Subtype_Indication (Ind); - end if; - end; - - when Iir_Kinds_Literal - | Iir_Kind_Simple_Aggregate - | Iir_Kind_Unit_Declaration => - null; - - when Iir_Kinds_Array_Attribute => - -- No need to canon parameter, since it is a locally static - -- expression. - declare - Prefix : constant Iir := Get_Prefix (Expr); - begin - if Get_Kind (Prefix) in Iir_Kinds_Denoting_Name - and then (Get_Kind (Get_Named_Entity (Prefix)) - in Iir_Kinds_Type_Declaration) - then - -- No canon for types. - null; - else - Canon_Expression (Prefix); - end if; - end; - - when Iir_Kinds_Type_Attribute => - null; - when Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Transaction_Attribute => - -- FIXME: add the default parameter ? - Canon_Expression (Get_Prefix (Expr)); - when Iir_Kind_Event_Attribute - | Iir_Kind_Last_Value_Attribute - | Iir_Kind_Active_Attribute - | Iir_Kind_Last_Event_Attribute - | Iir_Kind_Last_Active_Attribute - | Iir_Kind_Driving_Attribute - | Iir_Kind_Driving_Value_Attribute => - Canon_Expression (Get_Prefix (Expr)); - - when Iir_Kinds_Scalar_Type_Attribute - | Iir_Kind_Image_Attribute - | Iir_Kind_Value_Attribute => - Canon_Expression (Get_Parameter (Expr)); - - when Iir_Kind_Simple_Name_Attribute - | Iir_Kind_Path_Name_Attribute - | Iir_Kind_Instance_Name_Attribute => - null; - - when Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Object_Alias_Declaration => - null; - - when Iir_Kind_Enumeration_Literal - | Iir_Kind_Overflow_Literal => - null; - - when Iir_Kind_Element_Declaration => - null; - - when Iir_Kind_Attribute_Value - | Iir_Kind_Attribute_Name => - null; - - when others => - Error_Kind ("canon_expression", Expr); - null; - end case; - end Canon_Expression; - - procedure Canon_Discrete_Range (Rng : Iir) is - begin - case Get_Kind (Rng) is - when Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition => - Canon_Expression (Get_Range_Constraint (Rng)); - when Iir_Kind_Enumeration_Type_Definition => - null; - when others => - Error_Kind ("canon_discrete_range", Rng); - end case; - end Canon_Discrete_Range; - - procedure Canon_Waveform_Chain - (Chain : Iir_Waveform_Element; Sensitivity_List: Iir_List) - is - We: Iir_Waveform_Element; - begin - We := Chain; - while We /= Null_Iir loop - if Sensitivity_List /= Null_Iir_List then - Canon_Extract_Sensitivity - (Get_We_Value (We), Sensitivity_List, False); - end if; - if Canon_Flag_Expressions then - Canon_Expression (Get_We_Value (We)); - if Get_Time (We) /= Null_Iir then - Canon_Expression (Get_Time (We)); - end if; - end if; - We := Get_Chain (We); - end loop; - end Canon_Waveform_Chain; - - -- Names associations by position, - -- reorder associations by name, - -- create omitted association, - function Canon_Association_Chain - (Interface_Chain : Iir; Association_Chain : Iir; Loc : Iir) - return Iir - is - -- The canon list of association. - N_Chain, Last : Iir; - Inter : Iir; - Assoc_El, Prev_Assoc_El, Next_Assoc_El : Iir; - Assoc_Chain : Iir; - - Found : Boolean; - begin - -- No argument, so return now. - if Interface_Chain = Null_Iir then - pragma Assert (Association_Chain = Null_Iir); - return Null_Iir; - end if; - - Sub_Chain_Init (N_Chain, Last); - Assoc_Chain := Association_Chain; - - -- Reorder the list of association in the interface order. - -- Add missing associations. - Inter := Interface_Chain; - while Inter /= Null_Iir loop - -- Search associations with INTERFACE. - Found := False; - Assoc_El := Assoc_Chain; - Prev_Assoc_El := Null_Iir; - while Assoc_El /= Null_Iir loop - Next_Assoc_El := Get_Chain (Assoc_El); - if Get_Formal (Assoc_El) = Null_Iir then - Set_Formal (Assoc_El, Inter); - end if; - if Get_Association_Interface (Assoc_El) = Inter then - - -- Remove ASSOC_EL from ASSOC_CHAIN - if Prev_Assoc_El /= Null_Iir then - Set_Chain (Prev_Assoc_El, Next_Assoc_El); - else - Assoc_Chain := Next_Assoc_El; - end if; - - -- Append ASSOC_EL in N_CHAIN. - Set_Chain (Assoc_El, Null_Iir); - Sub_Chain_Append (N_Chain, Last, Assoc_El); - - case Get_Kind (Assoc_El) is - when Iir_Kind_Association_Element_Open => - goto Done; - when Iir_Kind_Association_Element_By_Expression => - if Get_Whole_Association_Flag (Assoc_El) then - goto Done; - end if; - when Iir_Kind_Association_Element_By_Individual => - Found := True; - when Iir_Kind_Association_Element_Package => - goto Done; - when others => - Error_Kind ("canon_association_chain", Assoc_El); - end case; - elsif Found then - -- No more associations. - goto Done; - else - Prev_Assoc_El := Assoc_El; - end if; - Assoc_El := Next_Assoc_El; - end loop; - if Found then - goto Done; - end if; - - -- No association, use default expr. - Assoc_El := Create_Iir (Iir_Kind_Association_Element_Open); - Set_Artificial_Flag (Assoc_El, True); - Set_Whole_Association_Flag (Assoc_El, True); - Location_Copy (Assoc_El, Loc); - Set_Formal (Assoc_El, Inter); - Sub_Chain_Append (N_Chain, Last, Assoc_El); - - << Done >> null; - Inter := Get_Chain (Inter); - end loop; - pragma Assert (Assoc_Chain = Null_Iir); - - return N_Chain; - end Canon_Association_Chain; - - procedure Canon_Association_Chain_Actuals (Association_Chain : Iir) - is - Assoc_El : Iir; - begin - -- Canon actuals. - Assoc_El := Association_Chain; - while Assoc_El /= Null_Iir loop - if Get_Kind (Assoc_El) = Iir_Kind_Association_Element_By_Expression - then - Canon_Expression (Get_Actual (Assoc_El)); - end if; - Assoc_El := Get_Chain (Assoc_El); - end loop; - end Canon_Association_Chain_Actuals; - - function Canon_Association_Chain_And_Actuals - (Interface_Chain: Iir; Association_Chain: Iir; Loc : Iir) - return Iir - is - Res : Iir; - begin - Res := Canon_Association_Chain (Interface_Chain, Association_Chain, Loc); - if Canon_Flag_Expressions then - Canon_Association_Chain_Actuals (Res); - end if; - return Res; - end Canon_Association_Chain_And_Actuals; - - procedure Canon_Subprogram_Call (Call : Iir) - is - Imp : constant Iir := Get_Implementation (Call); - Inter_Chain : constant Iir := Get_Interface_Declaration_Chain (Imp); - Assoc_Chain : Iir; - begin - Assoc_Chain := Get_Parameter_Association_Chain (Call); - Assoc_Chain := Canon_Association_Chain (Inter_Chain, Assoc_Chain, Call); - Set_Parameter_Association_Chain (Call, Assoc_Chain); - end Canon_Subprogram_Call; - - procedure Canon_Subprogram_Call_And_Actuals (Call : Iir) is - begin - Canon_Subprogram_Call (Call); - if Canon_Flag_Expressions then - Canon_Association_Chain_Actuals - (Get_Parameter_Association_Chain (Call)); - end if; - end Canon_Subprogram_Call_And_Actuals; - - -- Create a default association list for INTERFACE_LIST. - -- The default is a list of interfaces associated with open. - function Canon_Default_Association_Chain (Interface_Chain : Iir) - return Iir - is - Res : Iir; - Last : Iir; - Assoc, El : Iir; - begin - El := Interface_Chain; - Sub_Chain_Init (Res, Last); - while El /= Null_Iir loop - Assoc := Create_Iir (Iir_Kind_Association_Element_Open); - Set_Whole_Association_Flag (Assoc, True); - Set_Artificial_Flag (Assoc, True); - Set_Formal (Assoc, El); - Location_Copy (Assoc, El); - Sub_Chain_Append (Res, Last, Assoc); - El := Get_Chain (El); - end loop; - return Res; - end Canon_Default_Association_Chain; - --- function Canon_Default_Map_Association_List --- (Formal_List, Actual_List : Iir_List; Loc : Location_Type) --- return Iir_Association_List --- is --- Res : Iir_Association_List; --- Formal, Actual : Iir; --- Assoc : Iir; --- Nbr_Assoc : Natural; --- begin --- -- formal is the entity port/generic. --- if Formal_List = Null_Iir_List then --- if Actual_List /= Null_Iir_List then --- raise Internal_Error; --- end if; --- return Null_Iir_List; --- end if; - --- Res := Create_Iir (Iir_Kind_Association_List); --- Set_Location (Res, Loc); --- Nbr_Assoc := 0; --- for I in Natural loop --- Formal := Get_Nth_Element (Formal_List, I); --- exit when Formal = Null_Iir; --- Actual := Find_Name_In_List (Actual_List, Get_Identifier (Formal)); --- if Actual /= Null_Iir then --- Assoc := Create_Iir (Iir_Kind_Association_Element_By_Expression); --- Set_Whole_Association_Flag (Assoc, True); --- Set_Actual (Assoc, Actual); --- Nbr_Assoc := Nbr_Assoc + 1; --- else --- Assoc := Create_Iir (Iir_Kind_Association_Element_Open); --- end if; --- Set_Location (Assoc, Loc); --- Set_Formal (Assoc, Formal); --- Set_Associated_Formal (Assoc, Formal); --- Append_Element (Res, Assoc); --- end loop; --- if Nbr_Assoc /= Get_Nbr_Elements (Actual_List) then --- -- There is non-associated actuals. --- raise Internal_Error; --- end if; --- return Res; --- end Canon_Default_Map_Association_List; - - -- Inner loop if any; used to canonicalize exit/next statement. - Cur_Loop : Iir; - - procedure Canon_Sequential_Stmts (First : Iir) - is - Stmt: Iir; - Expr: Iir; - Prev_Loop : Iir; - begin - Stmt := First; - while Stmt /= Null_Iir loop - case Get_Kind (Stmt) is - when Iir_Kind_If_Statement => - declare - Cond: Iir; - Clause: Iir := Stmt; - begin - while Clause /= Null_Iir loop - Cond := Get_Condition (Clause); - if Cond /= Null_Iir then - Canon_Expression (Cond); - end if; - Canon_Sequential_Stmts - (Get_Sequential_Statement_Chain (Clause)); - Clause := Get_Else_Clause (Clause); - end loop; - end; - - when Iir_Kind_Signal_Assignment_Statement => - Canon_Expression (Get_Target (Stmt)); - Canon_Waveform_Chain (Get_Waveform_Chain (Stmt), Null_Iir_List); - - when Iir_Kind_Variable_Assignment_Statement => - Canon_Expression (Get_Target (Stmt)); - Canon_Expression (Get_Expression (Stmt)); - - when Iir_Kind_Wait_Statement => - declare - Expr: Iir; - List: Iir_List; - begin - Expr := Get_Timeout_Clause (Stmt); - if Expr /= Null_Iir then - Canon_Expression (Expr); - end if; - Expr := Get_Condition_Clause (Stmt); - if Expr /= Null_Iir then - Canon_Expression (Expr); - end if; - List := Get_Sensitivity_List (Stmt); - if List = Null_Iir_List and then Expr /= Null_Iir then - List := Create_Iir_List; - Canon_Extract_Sensitivity (Expr, List, False); - Set_Sensitivity_List (Stmt, List); - end if; - end; - - when Iir_Kind_Case_Statement => - Canon_Expression (Get_Expression (Stmt)); - declare - Choice: Iir; - begin - Choice := Get_Case_Statement_Alternative_Chain (Stmt); - while Choice /= Null_Iir loop - -- FIXME: canon choice expr. - Canon_Sequential_Stmts (Get_Associated_Chain (Choice)); - Choice := Get_Chain (Choice); - end loop; - end; - - when Iir_Kind_Assertion_Statement - | Iir_Kind_Report_Statement => - if Get_Kind (Stmt) = Iir_Kind_Assertion_Statement then - Canon_Expression (Get_Assertion_Condition (Stmt)); - end if; - Expr := Get_Report_Expression (Stmt); - if Expr /= Null_Iir then - Canon_Expression (Expr); - end if; - Expr := Get_Severity_Expression (Stmt); - if Expr /= Null_Iir then - Canon_Expression (Expr); - end if; - - when Iir_Kind_For_Loop_Statement => - -- FIXME: decl. - Prev_Loop := Cur_Loop; - Cur_Loop := Stmt; - if Canon_Flag_Expressions then - Canon_Discrete_Range - (Get_Type (Get_Parameter_Specification (Stmt))); - end if; - Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (Stmt)); - Cur_Loop := Prev_Loop; - - when Iir_Kind_While_Loop_Statement => - Expr := Get_Condition (Stmt); - if Expr /= Null_Iir then - Canon_Expression (Expr); - end if; - Prev_Loop := Cur_Loop; - Cur_Loop := Stmt; - Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (Stmt)); - Cur_Loop := Prev_Loop; - - when Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement => - declare - Loop_Label : Iir; - begin - Expr := Get_Condition (Stmt); - if Expr /= Null_Iir then - Canon_Expression (Expr); - end if; - Loop_Label := Get_Loop_Label (Stmt); - if Loop_Label = Null_Iir then - Set_Loop_Label (Stmt, Build_Simple_Name (Cur_Loop, Stmt)); - end if; - end; - - when Iir_Kind_Procedure_Call_Statement => - Canon_Subprogram_Call_And_Actuals (Get_Procedure_Call (Stmt)); - - when Iir_Kind_Null_Statement => - null; - - when Iir_Kind_Return_Statement => - Canon_Expression (Get_Expression (Stmt)); - - when others => - Error_Kind ("canon_sequential_stmts", Stmt); - end case; - Stmt := Get_Chain (Stmt); - end loop; - end Canon_Sequential_Stmts; - - -- Create a statement transform from concurrent_signal_assignment - -- statement STMT (either selected or conditional). - -- waveform transformation is not done. - -- PROC is the process created. - -- PARENT is the place where signal assignment must be placed. This may - -- be PROC, or an 'if' statement if the assignment is guarded. - -- See LRM93 9.5 - procedure Canon_Concurrent_Signal_Assignment - (Stmt: Iir; - Proc: out Iir_Sensitized_Process_Statement; - Chain : out Iir) - is - If_Stmt: Iir; - Sensitivity_List : Iir_List; - begin - Proc := Create_Iir (Iir_Kind_Sensitized_Process_Statement); - Location_Copy (Proc, Stmt); - Set_Parent (Proc, Get_Parent (Stmt)); - Sensitivity_List := Create_Iir_List; - Set_Sensitivity_List (Proc, Sensitivity_List); - Set_Process_Origin (Proc, Stmt); - - -- LRM93 9.5 - -- 1. If a label appears on the concurrent signal assignment, then the - -- same label appears on the process statement. - Set_Label (Proc, Get_Label (Stmt)); - - -- LRM93 9.5 - -- 2. The equivalent process statement is a postponed process if and - -- only if the current signal assignment statement includes the - -- reserved word POSTPONED. - Set_Postponed_Flag (Proc, Get_Postponed_Flag (Proc)); - - Canon_Extract_Sensitivity (Get_Target (Stmt), Sensitivity_List, True); - - if Canon_Flag_Expressions then - Canon_Expression (Get_Target (Stmt)); - end if; - - if Get_Guard (Stmt) /= Null_Iir then - -- LRM93 9.1 - -- If the option guarded appears in the concurrent signal assignment - -- statement, then the concurrent signal assignment is called a - -- guarded assignment. - -- If the concurrent signal assignement statement is a guarded - -- assignment and the target of the concurrent signal assignment is - -- a guarded target, then the statement transform is as follow: - -- if GUARD then signal_transform else disconnect_statements end if; - -- Otherwise, if the concurrent signal assignment statement is a - -- guarded assignement, but the target if the concurrent signal - -- assignment is not a guarded target, the then statement transform - -- is as follows: - -- if GUARD then signal_transform end if; - If_Stmt := Create_Iir (Iir_Kind_If_Statement); - Set_Parent (If_Stmt, Proc); - Set_Sequential_Statement_Chain (Proc, If_Stmt); - Location_Copy (If_Stmt, Stmt); - Canon_Extract_Sensitivity (Get_Guard (Stmt), Sensitivity_List, False); - Set_Condition (If_Stmt, Get_Guard (Stmt)); - Chain := If_Stmt; - - declare - Target : Iir; - Else_Clause : Iir_Elsif; - Dis_Stmt : Iir_Signal_Assignment_Statement; - begin - Target := Get_Target (Stmt); - if Get_Guarded_Target_State (Stmt) = True then - -- The target is a guarded target. - -- create the disconnection statement. - Else_Clause := Create_Iir (Iir_Kind_Elsif); - Location_Copy (Else_Clause, Stmt); - Set_Else_Clause (If_Stmt, Else_Clause); - Dis_Stmt := Create_Iir (Iir_Kind_Signal_Assignment_Statement); - Location_Copy (Dis_Stmt, Stmt); - Set_Parent (Dis_Stmt, If_Stmt); - Set_Target (Dis_Stmt, Target); - Set_Sequential_Statement_Chain (Else_Clause, Dis_Stmt); - -- XX - Set_Waveform_Chain (Dis_Stmt, Null_Iir); - end if; - end; - else - -- LRM93 9.1 - -- Finally, if the concurrent signal assignment statement is not a - -- guarded assignment, and the traget of the concurrent signal - -- assignment is not a guarded target, then the statement transform - -- is as follows: - -- signal_transform - Chain := Proc; - end if; - end Canon_Concurrent_Signal_Assignment; - - function Canon_Concurrent_Procedure_Call (El : Iir) - return Iir_Sensitized_Process_Statement - is - Proc : Iir_Sensitized_Process_Statement; - Call_Stmt : Iir_Procedure_Call_Statement; - Wait_Stmt : Iir_Wait_Statement; - Call : constant Iir_Procedure_Call := Get_Procedure_Call (El); - Imp : constant Iir := Get_Implementation (Call); - Assoc_Chain : Iir; - Assoc : Iir; - Inter : Iir; - Sensitivity_List : Iir_List; - Is_Sensitized : Boolean; - begin - -- Optimization: the process is a sensitized process only if the - -- procedure is known not to have wait statement. - Is_Sensitized := Get_Wait_State (Imp) = False; - - -- LRM93 9.3 - -- The equivalent process statement has also no sensitivity list, an - -- empty declarative part, and a statement part that consists of a - -- procedure call statement followed by a wait statement. - if Is_Sensitized then - Proc := Create_Iir (Iir_Kind_Sensitized_Process_Statement); - else - Proc := Create_Iir (Iir_Kind_Process_Statement); - end if; - Location_Copy (Proc, El); - Set_Parent (Proc, Get_Parent (El)); - Set_Process_Origin (Proc, El); - - -- LRM93 9.3 - -- The equivalent process statement has a label if and only if the - -- concurrent procedure call statement has a label; if the equivalent - -- process statement has a label, it is the same as that of the - -- concurrent procedure call statement. - Set_Label (Proc, Get_Label (El)); - - -- LRM93 9.3 - -- The equivalent process statement is a postponed process if and only - -- if the concurrent procedure call statement includes the reserved - -- word POSTPONED. - Set_Postponed_Flag (Proc, Get_Postponed_Flag (El)); - - Set_Attribute_Value_Chain (Proc, Get_Attribute_Value_Chain (El)); - - Call_Stmt := Create_Iir (Iir_Kind_Procedure_Call_Statement); - Set_Sequential_Statement_Chain (Proc, Call_Stmt); - Location_Copy (Call_Stmt, El); - Set_Parent (Call_Stmt, Proc); - Set_Procedure_Call (Call_Stmt, Call); - Assoc_Chain := Canon_Association_Chain_And_Actuals - (Get_Interface_Declaration_Chain (Imp), - Get_Parameter_Association_Chain (Call), - Call); - Set_Parameter_Association_Chain (Call, Assoc_Chain); - Assoc := Assoc_Chain; - - -- LRM93 9.3 - -- If there exists a name that denotes a signal in the actual part of - -- any association element in the concurrent procedure call statement, - -- and that actual is associated with a formal parameter of mode IN or - -- INOUT, then the equivalent process statement includes a final wait - -- statement with a sensitivity clause that is constructed by taking - -- the union of the sets constructed by applying th rule of Section 8.1 - -- to each actual part associated with a formal parameter. - Sensitivity_List := Create_Iir_List; - while Assoc /= Null_Iir loop - case Get_Kind (Assoc) is - when Iir_Kind_Association_Element_By_Expression => - Inter := Get_Association_Interface (Assoc); - if Get_Mode (Inter) in Iir_In_Modes then - Canon_Extract_Sensitivity - (Get_Actual (Assoc), Sensitivity_List, False); - end if; - when Iir_Kind_Association_Element_Open - | Iir_Kind_Association_Element_By_Individual => - null; - when others => - raise Internal_Error; - end case; - Assoc := Get_Chain (Assoc); - end loop; - if Is_Sensitized then - Set_Sensitivity_List (Proc, Sensitivity_List); - else - Wait_Stmt := Create_Iir (Iir_Kind_Wait_Statement); - Location_Copy (Wait_Stmt, El); - Set_Parent (Wait_Stmt, Proc); - Set_Sensitivity_List (Wait_Stmt, Sensitivity_List); - Set_Chain (Call_Stmt, Wait_Stmt); - end if; - return Proc; - end Canon_Concurrent_Procedure_Call; - - -- Return a statement from a waveform. - function Canon_Wave_Transform - (Orig_Stmt : Iir; Waveform_Chain : Iir_Waveform_Element; Proc : Iir) - return Iir - is - Stmt : Iir; - begin - if Waveform_Chain = Null_Iir then - -- LRM 9.5.1 Conditionnal Signal Assignment - -- If the waveform is of the form: - -- UNAFFECTED - -- then the wave transform in the corresponding process statement - -- is of the form: - -- NULL; - -- In this example, the final NULL causes the driver to be unchanged, - -- rather than disconnected. - -- (This is the null statement not a null waveform element). - Stmt := Create_Iir (Iir_Kind_Null_Statement); - else - -- LRM 9.5.1 Conditionnal Signal Assignment - -- If the waveform is of the form: - -- waveform_element1, waveform_element1, ..., waveform_elementN - -- then the wave transform in the corresponding process statement is - -- of the form: - -- target <= [ delay_mechanism ] waveform_element1, - -- waveform_element2, ..., waveform_elementN; - Stmt := Create_Iir (Iir_Kind_Signal_Assignment_Statement); - Set_Target (Stmt, Get_Target (Orig_Stmt)); - Canon_Waveform_Chain (Waveform_Chain, Get_Sensitivity_List (Proc)); - Set_Waveform_Chain (Stmt, Waveform_Chain); - Set_Delay_Mechanism (Stmt, Get_Delay_Mechanism (Orig_Stmt)); - Set_Reject_Time_Expression - (Stmt, Get_Reject_Time_Expression (Orig_Stmt)); - end if; - Location_Copy (Stmt, Orig_Stmt); - return Stmt; - end Canon_Wave_Transform; - - -- Create signal_transform for a conditional concurrent signal assignment. - procedure Canon_Conditional_Concurrent_Signal_Assigment - (Conc_Stmt : Iir; Proc : Iir; Parent : Iir) - is - Expr : Iir; - Stmt : Iir; - Res1 : Iir; - Last_Res : Iir; - Wf : Iir; - Cond_Wf : Iir_Conditional_Waveform; - Cond_Wf_Chain : Iir_Conditional_Waveform; - begin - Cond_Wf_Chain := Get_Conditional_Waveform_Chain (Conc_Stmt); - Stmt := Null_Iir; - Cond_Wf := Cond_Wf_Chain; - Last_Res := Null_Iir; - - while Cond_Wf /= Null_Iir loop - Expr := Get_Condition (Cond_Wf); - Wf := Canon_Wave_Transform - (Conc_Stmt, Get_Waveform_Chain (Cond_Wf), Proc); - Set_Parent (Wf, Parent); - if Expr = Null_Iir and Cond_Wf = Cond_Wf_Chain then - Res1 := Wf; - else - if Expr /= Null_Iir then - if Canon_Flag_Expressions then - Canon_Expression (Expr); - end if; - Canon_Extract_Sensitivity - (Expr, Get_Sensitivity_List (Proc), False); - end if; - if Stmt = Null_Iir then - Res1 := Create_Iir (Iir_Kind_If_Statement); - Set_Parent (Res1, Parent); - else - Res1 := Create_Iir (Iir_Kind_Elsif); - end if; - Location_Copy (Res1, Cond_Wf); - Set_Condition (Res1, Expr); - Set_Sequential_Statement_Chain (Res1, Wf); - end if; - if Stmt = Null_Iir then - Stmt := Res1; - else - Set_Else_Clause (Last_Res, Res1); - end if; - Last_Res := Res1; - Cond_Wf := Get_Chain (Cond_Wf); - end loop; - Set_Sequential_Statement_Chain (Parent, Stmt); - end Canon_Conditional_Concurrent_Signal_Assigment; - - procedure Canon_Selected_Concurrent_Signal_Assignment - (Conc_Stmt : Iir; Proc : Iir; Parent : Iir) - is - Selected_Waveform : Iir; - Case_Stmt: Iir_Case_Statement; - Expr : Iir; - Stmt : Iir; - Assoc : Iir; - begin - Case_Stmt := Create_Iir (Iir_Kind_Case_Statement); - Set_Parent (Case_Stmt, Parent); - Set_Sequential_Statement_Chain (Parent, Case_Stmt); - Location_Copy (Case_Stmt, Conc_Stmt); - Expr := Get_Expression (Conc_Stmt); - if Canon_Flag_Expressions then - Canon_Expression (Expr); - end if; - Set_Expression (Case_Stmt, Expr); - Canon_Extract_Sensitivity - (Expr, Get_Sensitivity_List (Proc), False); - - Selected_Waveform := Get_Selected_Waveform_Chain (Conc_Stmt); - Set_Case_Statement_Alternative_Chain (Case_Stmt, Selected_Waveform); - while Selected_Waveform /= Null_Iir loop - Assoc := Get_Associated_Chain (Selected_Waveform); - if Assoc /= Null_Iir then - Stmt := Canon_Wave_Transform (Conc_Stmt, Assoc, Proc); - Set_Parent (Stmt, Case_Stmt); - Set_Associated_Chain (Selected_Waveform, Stmt); - end if; - Selected_Waveform := Get_Chain (Selected_Waveform); - end loop; - end Canon_Selected_Concurrent_Signal_Assignment; - - procedure Canon_Concurrent_Stmts (Top : Iir_Design_Unit; Parent : Iir) - is - -- Current element in the chain of concurrent statements. - El: Iir; - -- Previous element or NULL_IIR if EL is the first element. - -- This is used to make Replace_Stmt efficient. - Prev_El : Iir; - - -- Replace in the chain EL by N_STMT. - procedure Replace_Stmt (N_Stmt : Iir) is - begin - if Prev_El = Null_Iir then - Set_Concurrent_Statement_Chain (Parent, N_Stmt); - else - Set_Chain (Prev_El, N_Stmt); - end if; - Set_Chain (N_Stmt, Get_Chain (El)); - end Replace_Stmt; - - Proc: Iir; - Stmt: Iir; - Sub_Chain : Iir; - Expr: Iir; - Proc_Num : Natural := 0; - Sensitivity_List : Iir_List; - begin - Prev_El := Null_Iir; - El := Get_Concurrent_Statement_Chain (Parent); - while El /= Null_Iir loop - -- Add a label if required. - if Canon_Flag_Add_Labels then - case Get_Kind (El) is - when Iir_Kind_Psl_Declaration => - null; - when others => - if Get_Label (El) = Null_Identifier then - declare - Str : String := Natural'Image (Proc_Num); - begin - -- Note: the label starts with a capitalized letter, - -- to avoid any clash with user's identifiers. - Str (1) := 'P'; - Set_Label (El, Name_Table.Get_Identifier (Str)); - end; - Proc_Num := Proc_Num + 1; - end if; - end case; - end if; - - case Get_Kind (El) is - when Iir_Kind_Concurrent_Conditional_Signal_Assignment => - Canon_Concurrent_Signal_Assignment (El, Proc, Sub_Chain); - - Canon_Conditional_Concurrent_Signal_Assigment - (El, Proc, Sub_Chain); - - Replace_Stmt (Proc); - Free_Iir (El); - El := Proc; - - when Iir_Kind_Concurrent_Selected_Signal_Assignment => - Canon_Concurrent_Signal_Assignment (El, Proc, Sub_Chain); - - Canon_Selected_Concurrent_Signal_Assignment - (El, Proc, Sub_Chain); - - Replace_Stmt (Proc); - Free_Iir (El); - El := Proc; - - when Iir_Kind_Concurrent_Assertion_Statement => - -- Create a new entry. - Proc := Create_Iir (Iir_Kind_Sensitized_Process_Statement); - Location_Copy (Proc, El); - Set_Parent (Proc, Get_Parent (El)); - Set_Process_Origin (Proc, El); - - -- LRM93 9.4 - -- The equivalent process statement has a label if and only if - -- the current assertion statement has a label; if the - -- equivalent process statement has a label; it is the same - -- as that of the concurrent assertion statement. - Set_Label (Proc, Get_Label (El)); - - -- LRM93 9.4 - -- The equivalent process statement is a postponed process if - -- and only if the current assertion statement includes the - -- reserved word POSTPONED. - Set_Postponed_Flag (Proc, Get_Postponed_Flag (El)); - - Stmt := Create_Iir (Iir_Kind_Assertion_Statement); - Set_Sequential_Statement_Chain (Proc, Stmt); - Set_Parent (Stmt, Proc); - Location_Copy (Stmt, El); - Sensitivity_List := Create_Iir_List; - Set_Sensitivity_List (Proc, Sensitivity_List); - - -- Expand the expression, fill the sensitivity list, - Canon_Extract_Sensitivity - (Get_Assertion_Condition (El), Sensitivity_List, False); - if Canon_Flag_Expressions then - Canon_Expression (Get_Assertion_Condition (El)); - end if; - Set_Assertion_Condition - (Stmt, Get_Assertion_Condition (El)); - - Expr := Get_Report_Expression (El); - if Canon_Flag_Expressions and Expr /= Null_Iir then - Canon_Expression (Expr); - end if; - Set_Report_Expression (Stmt, Expr); - - Expr := Get_Severity_Expression (El); - if Canon_Flag_Expressions and Expr /= Null_Iir then - Canon_Expression (Expr); - end if; - Set_Severity_Expression (Stmt, Expr); - - Replace_Stmt (Proc); - El := Proc; - - when Iir_Kind_Concurrent_Procedure_Call_Statement => - Proc := Canon_Concurrent_Procedure_Call (El); - Replace_Stmt (Proc); - El := Proc; - - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - Canon_Declarations (Top, El, Null_Iir); - if Canon_Flag_Sequentials_Stmts then - Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (El)); - end if; - if Canon_Flag_All_Sensitivity - and then Canon_Flag_Sequentials_Stmts - and then Get_Kind (El) = Iir_Kind_Sensitized_Process_Statement - and then Get_Sensitivity_List (El) = Iir_List_All - then - Set_Sensitivity_List - (El, Canon_Extract_Process_Sensitivity (El)); - end if; - - when Iir_Kind_Component_Instantiation_Statement => - declare - Inst : Iir; - Assoc_Chain : Iir; - begin - Inst := Get_Instantiated_Unit (El); - Inst := Get_Entity_From_Entity_Aspect (Inst); - Assoc_Chain := Canon_Association_Chain_And_Actuals - (Get_Generic_Chain (Inst), - Get_Generic_Map_Aspect_Chain (El), - El); - Set_Generic_Map_Aspect_Chain (El, Assoc_Chain); - - Assoc_Chain := Canon_Association_Chain_And_Actuals - (Get_Port_Chain (Inst), - Get_Port_Map_Aspect_Chain (El), - El); - Set_Port_Map_Aspect_Chain (El, Assoc_Chain); - end; - - when Iir_Kind_Block_Statement => - declare - Header : Iir_Block_Header; - Chain : Iir; - Guard : Iir_Guard_Signal_Declaration; - begin - Guard := Get_Guard_Decl (El); - if Guard /= Null_Iir then - Expr := Get_Guard_Expression (Guard); - Set_Guard_Sensitivity_List (Guard, Create_Iir_List); - Canon_Extract_Sensitivity - (Expr, Get_Guard_Sensitivity_List (Guard), False); - if Canon_Flag_Expressions then - Canon_Expression (Expr); - end if; - end if; - Header := Get_Block_Header (El); - if Header /= Null_Iir then - -- Generics. - Chain := Get_Generic_Map_Aspect_Chain (Header); - if Chain /= Null_Iir then - Chain := Canon_Association_Chain_And_Actuals - (Get_Generic_Chain (Header), Chain, Chain); - else - Chain := Canon_Default_Association_Chain - (Get_Generic_Chain (Header)); - end if; - Set_Generic_Map_Aspect_Chain (Header, Chain); - - -- Ports. - Chain := Get_Port_Map_Aspect_Chain (Header); - if Chain /= Null_Iir then - Chain := Canon_Association_Chain_And_Actuals - (Get_Port_Chain (Header), Chain, Chain); - else - Chain := Canon_Default_Association_Chain - (Get_Port_Chain (Header)); - end if; - Set_Port_Map_Aspect_Chain (Header, Chain); - end if; - Canon_Declarations (Top, El, El); - Canon_Concurrent_Stmts (Top, El); - end; - - when Iir_Kind_Generate_Statement => - declare - Scheme : Iir; - begin - Scheme := Get_Generation_Scheme (El); - if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then - Canon_Declaration (Top, Scheme, Null_Iir, Null_Iir); - elsif Canon_Flag_Expressions then - Canon_Expression (Scheme); - end if; - Canon_Declarations (Top, El, El); - Canon_Concurrent_Stmts (Top, El); - end; - - when Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement => - declare - use PSL.Nodes; - Prop : PSL_Node; - Fa : PSL_NFA; - begin - Prop := Get_Psl_Property (El); - Prop := PSL.Rewrites.Rewrite_Property (Prop); - Set_Psl_Property (El, Prop); - -- Generate the NFA. - Fa := PSL.Build.Build_FA (Prop); - Set_PSL_NFA (El, Fa); - - -- FIXME: report/severity. - end; - - when Iir_Kind_Psl_Default_Clock => - null; - when Iir_Kind_Psl_Declaration => - declare - use PSL.Nodes; - Decl : PSL_Node; - Prop : PSL_Node; - Fa : PSL_NFA; - begin - Decl := Get_Psl_Declaration (El); - case Get_Kind (Decl) is - when N_Property_Declaration => - Prop := Get_Property (Decl); - Prop := PSL.Rewrites.Rewrite_Property (Prop); - Set_Property (Decl, Prop); - if Get_Parameter_List (Decl) = Null_Node then - -- Generate the NFA. - Fa := PSL.Build.Build_FA (Prop); - Set_PSL_NFA (El, Fa); - end if; - when N_Sequence_Declaration - | N_Endpoint_Declaration => - Prop := Get_Sequence (Decl); - Prop := PSL.Rewrites.Rewrite_SERE (Prop); - Set_Sequence (Decl, Prop); - when others => - Error_Kind ("canon psl_declaration", Decl); - end case; - end; - - when Iir_Kind_Simple_Simultaneous_Statement => - if Canon_Flag_Expressions then - Canon_Expression (Get_Simultaneous_Left (El)); - Canon_Expression (Get_Simultaneous_Right (El)); - end if; - - when others => - Error_Kind ("canon_concurrent_stmts", El); - end case; - Prev_El := El; - El := Get_Chain (El); - end loop; - end Canon_Concurrent_Stmts; - --- procedure Canon_Binding_Indication --- (Component: Iir; Binding : Iir_Binding_Indication) --- is --- List : Iir_Association_List; --- begin --- if Binding = Null_Iir then --- return; --- end if; --- List := Get_Generic_Map_Aspect_List (Binding); --- List := Canon_Association_List (Get_Generic_List (Component), List); --- Set_Generic_Map_Aspect_List (Binding, List); --- List := Get_Port_Map_Aspect_List (Binding); --- List := Canon_Association_List (Get_Port_List (Component), List); --- Set_Port_Map_Aspect_List (Binding, List); --- end Canon_Binding_Indication; - - procedure Add_Binding_Indication_Dependence (Top : Iir_Design_Unit; - Binding : Iir) - is - Aspect : Iir; - begin - if Binding = Null_Iir then - return; - end if; - Aspect := Get_Entity_Aspect (Binding); - if Aspect = Null_Iir then - return; - end if; - case Get_Kind (Aspect) is - when Iir_Kind_Entity_Aspect_Entity => - if Get_Architecture (Aspect) /= Null_Iir then - Add_Dependence (Top, Aspect); - else - Add_Dependence (Top, Get_Design_Unit (Get_Entity (Aspect))); - end if; - when Iir_Kind_Entity_Aspect_Configuration => - Add_Dependence (Top, Get_Design_Unit (Get_Configuration (Aspect))); - when Iir_Kind_Entity_Aspect_Open => - null; - when others => - Error_Kind ("add_binding_indication_dependence", Aspect); - end case; - end Add_Binding_Indication_Dependence; - - -- Canon the component_configuration or configuration_specification CFG. - procedure Canon_Component_Configuration (Top : Iir_Design_Unit; Cfg : Iir) - is - -- True iff CFG is a component_configuration. - -- False iff CFG is a configuration_specification. - Is_Config : constant Boolean := - Get_Kind (Cfg) = Iir_Kind_Component_Configuration; - - Bind : Iir; - Instances : Iir_List; - Entity_Aspect : Iir; - Block : Iir_Block_Configuration; - Map_Chain : Iir; - Entity : Iir; - begin - Bind := Get_Binding_Indication (Cfg); - if Bind = Null_Iir then - -- Add a default binding indication - -- Extract a component instantiation - Instances := Get_Instantiation_List (Cfg); - if Instances = Iir_List_All or Instances = Iir_List_Others then - -- designator_all and designator_others must have been replaced - -- by a list during canon. - raise Internal_Error; - else - Bind := Get_Default_Binding_Indication - (Get_Named_Entity (Get_First_Element (Instances))); - end if; - if Bind = Null_Iir then - -- Component is not bound. - return; - end if; - Set_Binding_Indication (Cfg, Bind); - Add_Binding_Indication_Dependence (Top, Bind); - return; - else - Entity_Aspect := Get_Entity_Aspect (Bind); - if Entity_Aspect = Null_Iir then - Entity_Aspect := Get_Default_Entity_Aspect (Bind); - Set_Entity_Aspect (Bind, Entity_Aspect); - end if; - if Entity_Aspect /= Null_Iir then - Add_Binding_Indication_Dependence (Top, Bind); - Entity := Get_Entity_From_Entity_Aspect (Entity_Aspect); - Map_Chain := Get_Generic_Map_Aspect_Chain (Bind); - if Map_Chain = Null_Iir then - if Is_Config then - Map_Chain := Get_Default_Generic_Map_Aspect_Chain (Bind); - end if; - else - Map_Chain := Canon_Association_Chain - (Get_Generic_Chain (Entity), Map_Chain, Map_Chain); - end if; - Set_Generic_Map_Aspect_Chain (Bind, Map_Chain); - - Map_Chain := Get_Port_Map_Aspect_Chain (Bind); - if Map_Chain = Null_Iir then - if Is_Config then - Map_Chain := Get_Default_Port_Map_Aspect_Chain (Bind); - end if; - else - Map_Chain := Canon_Association_Chain - (Get_Port_Chain (Entity), Map_Chain, Map_Chain); - end if; - Set_Port_Map_Aspect_Chain (Bind, Map_Chain); - - if Get_Kind (Cfg) = Iir_Kind_Component_Configuration then - Block := Get_Block_Configuration (Cfg); - if Block /= Null_Iir then - -- If there is no architecture_identifier in the binding, - -- set it from the block_configuration. - if Get_Kind (Entity_Aspect) = Iir_Kind_Entity_Aspect_Entity - and then Get_Architecture (Entity_Aspect) = Null_Iir - then - Entity := Get_Entity (Entity_Aspect); - if Get_Kind (Entity) /= Iir_Kind_Entity_Declaration then - raise Internal_Error; - end if; - Set_Architecture - (Entity_Aspect, Get_Block_Specification (Block)); - end if; - Canon_Block_Configuration (Top, Block); - end if; - end if; - end if; - end if; - end Canon_Component_Configuration; - - procedure Canon_Incremental_Binding - (Conf_Spec : Iir_Configuration_Specification; - Comp_Conf : Iir_Component_Configuration; - Parent : Iir) - is - function Merge_Association_Chain - (Inter_Chain : Iir; First_Chain : Iir; Sec_Chain : Iir) - return Iir - is - -- Result (chain). - First, Last : Iir; - - -- Copy an association and append new elements to FIRST/LAST. - procedure Copy_Association (Assoc : in out Iir; Inter : Iir) - is - El : Iir; - begin - loop - El := Create_Iir (Get_Kind (Assoc)); - Location_Copy (El, Assoc); - Set_Formal (El, Get_Formal (Assoc)); - Set_Whole_Association_Flag - (El, Get_Whole_Association_Flag (Assoc)); - - case Get_Kind (Assoc) is - when Iir_Kind_Association_Element_Open => - null; - when Iir_Kind_Association_Element_By_Expression => - Set_Actual (El, Get_Actual (Assoc)); - Set_In_Conversion (El, Get_In_Conversion (Assoc)); - Set_Out_Conversion (El, Get_Out_Conversion (Assoc)); - Set_Collapse_Signal_Flag - (Assoc, - Sem.Can_Collapse_Signals (Assoc, Get_Formal (Assoc))); - when Iir_Kind_Association_Element_By_Individual => - Set_Actual_Type (El, Get_Actual_Type (Assoc)); - Set_Individual_Association_Chain - (El, Get_Individual_Association_Chain (Assoc)); - when others => - Error_Kind ("copy_association", Assoc); - end case; - - Sub_Chain_Append (First, Last, El); - Assoc := Get_Chain (Assoc); - exit when Assoc = Null_Iir; - exit when Get_Association_Interface (Assoc) /= Inter; - end loop; - end Copy_Association; - - procedure Advance (Assoc : in out Iir; Inter : Iir) - is - begin - loop - Assoc := Get_Chain (Assoc); - exit when Assoc = Null_Iir; - exit when Get_Association_Interface (Assoc) /= Inter; - end loop; - end Advance; - - Inter : Iir; - F_El : Iir; - S_El : Iir; - begin - if Sec_Chain = Null_Iir then - -- Short-cut. - return First_Chain; - end if; - F_El := First_Chain; - Sub_Chain_Init (First, Last); - Inter := Inter_Chain; - while Inter /= Null_Iir loop - -- Consistency check. - pragma Assert (Get_Association_Interface (F_El) = Inter); - - -- Find the associated in the second chain. - S_El := Sec_Chain; - while S_El /= Null_Iir loop - exit when Get_Association_Interface (S_El) = Inter; - S_El := Get_Chain (S_El); - end loop; - if S_El /= Null_Iir - and then Get_Kind (S_El) /= Iir_Kind_Association_Element_Open - then - Copy_Association (S_El, Inter); - Advance (F_El, Inter); - else - Copy_Association (F_El, Inter); - end if; - Inter := Get_Chain (Inter); - end loop; - return First; - end Merge_Association_Chain; - - Res : Iir_Component_Configuration; - Cs_Binding : Iir_Binding_Indication; - Cc_Binding : Iir_Binding_Indication; - Cs_Chain : Iir; - Res_Binding : Iir_Binding_Indication; - Entity : Iir; - Instance_List : Iir_List; - Conf_Instance_List : Iir_List; - Instance : Iir; - Instance_Name : Iir; - N_Nbr : Natural; - begin - -- Create the new component configuration - Res := Create_Iir (Iir_Kind_Component_Configuration); - Location_Copy (Res, Comp_Conf); - Set_Parent (Res, Parent); - Set_Component_Name (Res, Get_Component_Name (Conf_Spec)); - --- -- Keep in the designator list only the non-incrementally --- -- bound instances. --- Inst_List := Get_Instantiation_List (Comp_Conf); --- Designator_List := Create_Iir_List; --- for I in 0 .. Get_Nbr_Elements (Inst_List) - 1 loop --- Inst := Get_Nth_Element (Inst_List, I); --- if Get_Component_Configuration (Inst) = Comp_Conf then --- Set_Component_Configuration (Inst, Res); --- Append_Element (Designator_List, Inst); --- end if; --- end loop; --- Set_Instantiation_List (Res, Designator_List); --- Set_Binding_Indication --- (Res, Get_Binding_Indication (Comp_Conf)); --- Append (Last_Item, Conf, Comp_Conf); - - Cs_Binding := Get_Binding_Indication (Conf_Spec); - Cc_Binding := Get_Binding_Indication (Comp_Conf); - Res_Binding := Create_Iir (Iir_Kind_Binding_Indication); - Location_Copy (Res_Binding, Res); - Set_Binding_Indication (Res, Res_Binding); - - Entity := Get_Entity_From_Entity_Aspect (Get_Entity_Aspect (Cs_Binding)); - - -- Merge generic map aspect. - Cs_Chain := Get_Generic_Map_Aspect_Chain (Cs_Binding); - if Cs_Chain = Null_Iir then - Cs_Chain := Get_Default_Generic_Map_Aspect_Chain (Cs_Binding); - end if; - Set_Generic_Map_Aspect_Chain - (Res_Binding, - Merge_Association_Chain (Get_Generic_Chain (Entity), - Cs_Chain, - Get_Generic_Map_Aspect_Chain (Cc_Binding))); - - -- merge port map aspect - Cs_Chain := Get_Port_Map_Aspect_Chain (Cs_Binding); - if Cs_Chain = Null_Iir then - Cs_Chain := Get_Default_Port_Map_Aspect_Chain (Cs_Binding); - end if; - Set_Port_Map_Aspect_Chain - (Res_Binding, - Merge_Association_Chain (Get_Port_Chain (Entity), - Cs_Chain, - Get_Port_Map_Aspect_Chain (Cc_Binding))); - - -- set entity aspect - Set_Entity_Aspect (Res_Binding, Get_Entity_Aspect (Cs_Binding)); - - -- create list of instances: - -- * keep common instances - -- replace component_configuration of them - -- remove them in the instance list of COMP_CONF - Instance_List := Create_Iir_List; - Set_Instantiation_List (Res, Instance_List); - Conf_Instance_List := Get_Instantiation_List (Comp_Conf); - N_Nbr := 0; - for I in 0 .. Get_Nbr_Elements (Conf_Instance_List) - 1 loop - Instance_Name := Get_Nth_Element (Conf_Instance_List, I); - Instance := Get_Named_Entity (Instance_Name); - if Get_Component_Configuration (Instance) = Conf_Spec then - -- The incremental binding applies to this instance. - Set_Component_Configuration (Instance, Res); - Append_Element (Instance_List, Instance_Name); - else - Replace_Nth_Element (Conf_Instance_List, N_Nbr, Instance_Name); - N_Nbr := N_Nbr + 1; - end if; - end loop; - Set_Nbr_Elements (Conf_Instance_List, N_Nbr); - - -- Insert RES. - Set_Chain (Res, Get_Chain (Comp_Conf)); - Set_Chain (Comp_Conf, Res); - end Canon_Incremental_Binding; - - procedure Canon_Component_Specification_All_Others - (Conf : Iir; Parent : Iir; Spec : Iir_List; List : Iir_List; Comp : Iir) - is - El : Iir; - Comp_Conf : Iir; - begin - El := Get_Concurrent_Statement_Chain (Parent); - while El /= Null_Iir loop - case Get_Kind (El) is - when Iir_Kind_Component_Instantiation_Statement => - if Is_Component_Instantiation (El) - and then Get_Named_Entity (Get_Instantiated_Unit (El)) = Comp - then - Comp_Conf := Get_Component_Configuration (El); - if Comp_Conf = Null_Iir then - -- The component is not yet configured. - Append_Element (List, Build_Simple_Name (El, El)); - Set_Component_Configuration (El, Conf); - else - -- The component is already configured. - -- Handle incremental configuration. - if (Get_Kind (Comp_Conf) - = Iir_Kind_Configuration_Specification) - and then Spec = Iir_List_All - then - -- FIXME: handle incremental configuration. - raise Internal_Error; - end if; - if Spec = Iir_List_All then - -- Several component configuration for an instance. - -- Must have been caught by sem. - raise Internal_Error; - elsif Spec = Iir_List_Others then - null; - else - raise Internal_Error; - end if; - end if; - end if; - when Iir_Kind_Generate_Statement => - if False - and then Vhdl_Std = Vhdl_87 - and then - Get_Kind (Conf) = Iir_Kind_Configuration_Specification - then - Canon_Component_Specification_All_Others - (Conf, El, Spec, List, Comp); - end if; - when others => - null; - end case; - El := Get_Chain (El); - end loop; - end Canon_Component_Specification_All_Others; - - procedure Canon_Component_Specification_List - (Conf : Iir; Parent : Iir; Spec : Iir_List) - is - El : Iir; - Comp_Conf : Iir; - begin - -- Already has a designator list. - for I in Natural loop - El := Get_Nth_Element (Spec, I); - exit when El = Null_Iir; - El := Get_Named_Entity (El); - Comp_Conf := Get_Component_Configuration (El); - if Comp_Conf /= Null_Iir and then Comp_Conf /= Conf then - if Get_Kind (Comp_Conf) /= Iir_Kind_Configuration_Specification - or else Get_Kind (Conf) /= Iir_Kind_Component_Configuration - then - raise Internal_Error; - end if; - Canon_Incremental_Binding (Comp_Conf, Conf, Parent); - else - Set_Component_Configuration (El, Conf); - end if; - end loop; - end Canon_Component_Specification_List; - - -- PARENT is the parent for the chain of concurrent statements. - procedure Canon_Component_Specification (Conf : Iir; Parent : Iir) - is - Spec : constant Iir_List := Get_Instantiation_List (Conf); - List : Iir_Designator_List; - begin - if Spec = Iir_List_All or Spec = Iir_List_Others then - List := Create_Iir_List; - Canon_Component_Specification_All_Others - (Conf, Parent, Spec, List, - Get_Named_Entity (Get_Component_Name (Conf))); - Set_Instantiation_List (Conf, List); - else - -- Has Already a designator list. - Canon_Component_Specification_List (Conf, Parent, Spec); - end if; - end Canon_Component_Specification; - - -- Replace ALL/OTHERS with the explicit list of signals. - procedure Canon_Disconnection_Specification - (Dis : Iir_Disconnection_Specification; Decl_Parent : Iir) - is - Signal_List : Iir_List; - Force : Boolean; - El : Iir; - N_List : Iir_Designator_List; - Dis_Type : Iir; - begin - if Canon_Flag_Expressions then - Canon_Expression (Get_Expression (Dis)); - end if; - Signal_List := Get_Signal_List (Dis); - if Signal_List = Iir_List_All then - Force := True; - elsif Signal_List = Iir_List_Others then - Force := False; - else - return; - end if; - Dis_Type := Get_Type (Get_Type_Mark (Dis)); - N_List := Create_Iir_List; - Set_Signal_List (Dis, N_List); - El := Get_Declaration_Chain (Decl_Parent); - while El /= Null_Iir loop - if Get_Kind (El) = Iir_Kind_Signal_Declaration - and then Get_Type (El) = Dis_Type - and then Get_Signal_Kind (El) /= Iir_No_Signal_Kind - then - if not Get_Has_Disconnect_Flag (El) then - Set_Has_Disconnect_Flag (El, True); - Append_Element (N_List, El); - else - if Force then - raise Internal_Error; - end if; - end if; - end if; - El := Get_Chain (El); - end loop; - end Canon_Disconnection_Specification; - - procedure Canon_Subtype_Indication (Def : Iir) is - begin - case Get_Kind (Def) is - when Iir_Kind_Array_Subtype_Definition => - declare - Indexes : constant Iir_List := Get_Index_Subtype_List (Def); - Index : Iir; - begin - for I in Natural loop - Index := Get_Nth_Element (Indexes, I); - exit when Index = Null_Iir; - Canon_Subtype_Indication_If_Anonymous (Index); - end loop; - end; - when Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition => - declare - Rng : constant Iir := Get_Range_Constraint (Def); - begin - if Get_Kind (Rng) = Iir_Kind_Range_Expression then - Canon_Expression (Rng); - end if; - end; - when Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Record_Type_Definition => - null; - when Iir_Kind_Access_Subtype_Definition => - null; - when others => - Error_Kind ("canon_subtype_indication", Def); - end case; - end Canon_Subtype_Indication; - - procedure Canon_Subtype_Indication_If_Anonymous (Def : Iir) is - begin - if Is_Anonymous_Type_Definition (Def) then - Canon_Subtype_Indication (Def); - end if; - end Canon_Subtype_Indication_If_Anonymous; - - procedure Canon_Declaration (Top : Iir_Design_Unit; - Decl : Iir; - Parent : Iir; - Decl_Parent : Iir) - is - begin - case Get_Kind (Decl) is - when Iir_Kind_Procedure_Body - | Iir_Kind_Function_Body => - Canon_Declarations (Top, Decl, Null_Iir); - if Canon_Flag_Sequentials_Stmts then - Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (Decl)); - end if; - - when Iir_Kind_Procedure_Declaration - | Iir_Kind_Function_Declaration => - null; - - when Iir_Kind_Type_Declaration => - declare - Def : Iir; - begin - Def := Get_Type_Definition (Decl); - if Get_Kind (Def) = Iir_Kind_Protected_Type_Declaration then - Canon_Declarations (Decl, Def, Null_Iir); - end if; - end; - - when Iir_Kind_Anonymous_Type_Declaration - | Iir_Kind_Subtype_Declaration => - null; - - when Iir_Kind_Protected_Type_Body => - Canon_Declarations (Top, Decl, Null_Iir); - - when Iir_Kind_Variable_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Constant_Declaration => - if Canon_Flag_Expressions then - Canon_Subtype_Indication_If_Anonymous (Get_Type (Decl)); - Canon_Expression (Get_Default_Value (Decl)); - end if; - - when Iir_Kind_Iterator_Declaration => - null; - - when Iir_Kind_Object_Alias_Declaration => - null; - when Iir_Kind_Non_Object_Alias_Declaration => - null; - - when Iir_Kind_File_Declaration => - -- FIXME - null; - - when Iir_Kind_Attribute_Declaration => - null; - when Iir_Kind_Attribute_Specification => - if Canon_Flag_Expressions then - Canon_Expression (Get_Expression (Decl)); - end if; - when Iir_Kind_Disconnection_Specification => - Canon_Disconnection_Specification (Decl, Decl_Parent); - - when Iir_Kind_Group_Template_Declaration => - null; - when Iir_Kind_Group_Declaration => - null; - - when Iir_Kind_Use_Clause => - null; - - when Iir_Kind_Component_Declaration => - null; - - when Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Implicit_Function_Declaration => - null; - - when Iir_Kind_Configuration_Specification => - Canon_Component_Specification (Decl, Parent); - Canon_Component_Configuration (Top, Decl); --- declare --- List : Iir_List; --- Binding : Iir_Binding_Indication; --- Component : Iir_Component_Declaration; --- Aspect : Iir; --- Entity : Iir; --- begin --- Binding := Get_Binding_Indication (Decl); --- Component := Get_Component_Name (Decl); --- Aspect := Get_Entity_Aspect (Binding); --- case Get_Kind (Aspect) is --- when Iir_Kind_Entity_Aspect_Entity => --- Entity := Get_Entity (Aspect); --- when others => --- Error_Kind ("configuration_specification", Aspect); --- end case; --- Entity := Get_Library_Unit (Entity); --- List := Get_Generic_Map_Aspect_List (Binding); --- if List = Null_Iir_List then --- Set_Generic_Map_Aspect_List --- (Binding, --- Canon_Default_Map_Association_List --- (Get_Generic_List (Entity), Get_Generic_List (Component), --- Get_Location (Decl))); --- end if; --- List := Get_Port_Map_Aspect_List (Binding); --- if List = Null_Iir_List then --- Set_Port_Map_Aspect_List --- (Binding, --- Canon_Default_Map_Association_List --- (Get_Port_List (Entity), Get_Port_List (Component), --- Get_Location (Decl))); --- end if; --- end; - - when Iir_Kinds_Signal_Attribute => - null; - - when Iir_Kind_Nature_Declaration => - null; - when Iir_Kind_Terminal_Declaration => - null; - when Iir_Kinds_Quantity_Declaration => - null; - when others => - Error_Kind ("canon_declaration", Decl); - end case; - end Canon_Declaration; - - procedure Canon_Declarations (Top : Iir_Design_Unit; - Decl_Parent : Iir; - Parent : Iir) - is - Decl : Iir; - begin - if Parent /= Null_Iir then - Clear_Instantiation_Configuration (Parent, True); - end if; - Decl := Get_Declaration_Chain (Decl_Parent); - while Decl /= Null_Iir loop - Canon_Declaration (Top, Decl, Parent, Decl_Parent); - Decl := Get_Chain (Decl); - end loop; - end Canon_Declarations; - - procedure Canon_Block_Configuration (Top : Iir_Design_Unit; - Conf : Iir_Block_Configuration) - is - use Iir_Chains.Configuration_Item_Chain_Handling; - Spec : constant Iir := Get_Block_Specification (Conf); - Blk : constant Iir := Get_Block_From_Block_Specification (Spec); - Stmts : constant Iir := Get_Concurrent_Statement_Chain (Blk); - El : Iir; - Sub_Blk : Iir; - Last_Item : Iir; - begin - -- Note: the only allowed declarations are use clauses, which are not - -- canonicalized. - - -- FIXME: handle indexed/sliced name? - - Clear_Instantiation_Configuration (Blk, False); - - Build_Init (Last_Item, Conf); - - -- 1) Configure instantiations with configuration specifications. - -- TODO: merge. - El := Get_Declaration_Chain (Blk); - while El /= Null_Iir loop - if Get_Kind (El) = Iir_Kind_Configuration_Specification then - -- Already canoncalized during canon of block declarations. - -- But need to set configuration on instantiations. - Canon_Component_Specification (El, Blk); - end if; - El := Get_Chain (El); - end loop; - - -- 2) Configure instantations with component configurations, - -- and map block configurations with block/generate statements. - El := Get_Configuration_Item_Chain (Conf); - while El /= Null_Iir loop - case Get_Kind (El) is - when Iir_Kind_Configuration_Specification => - raise Internal_Error; - when Iir_Kind_Component_Configuration => - Canon_Component_Specification (El, Blk); - when Iir_Kind_Block_Configuration => - Sub_Blk := Strip_Denoting_Name (Get_Block_Specification (El)); - case Get_Kind (Sub_Blk) is - when Iir_Kind_Block_Statement => - Set_Block_Block_Configuration (Sub_Blk, El); - when Iir_Kind_Indexed_Name - | Iir_Kind_Slice_Name => - Sub_Blk := Strip_Denoting_Name (Get_Prefix (Sub_Blk)); - Set_Prev_Block_Configuration - (El, Get_Generate_Block_Configuration (Sub_Blk)); - Set_Generate_Block_Configuration (Sub_Blk, El); - when Iir_Kind_Generate_Statement => - Set_Generate_Block_Configuration (Sub_Blk, El); - when others => - Error_Kind ("canon_block_configuration(0)", Sub_Blk); - end case; - when others => - Error_Kind ("canon_block_configuration(1)", El); - end case; - El := Get_Chain (El); - end loop; - - -- 3) Add default component configuration for unspecified component - -- instantiation statements, - -- Add default block configuration for unconfigured block statements. - El := Stmts; - while El /= Null_Iir loop - case Get_Kind (El) is - when Iir_Kind_Component_Instantiation_Statement => - declare - Comp_Conf : Iir; - Res : Iir_Component_Configuration; - Designator_List : Iir_List; - Inst_List : Iir_List; - Inst : Iir; - Inst_Name : Iir; - begin - Comp_Conf := Get_Component_Configuration (El); - if Comp_Conf = Null_Iir then - if Is_Component_Instantiation (El) then - -- Create a component configuration. - -- FIXME: should merge all these default configuration - -- of the same component. - Res := Create_Iir (Iir_Kind_Component_Configuration); - Location_Copy (Res, El); - Set_Parent (Res, Conf); - Set_Component_Name (Res, Get_Instantiated_Unit (El)); - Designator_List := Create_Iir_List; - Append_Element - (Designator_List, Build_Simple_Name (El, El)); - Set_Instantiation_List (Res, Designator_List); - Append (Last_Item, Conf, Res); - end if; - elsif Get_Kind (Comp_Conf) - = Iir_Kind_Configuration_Specification - then - -- Create component configuration - Res := Create_Iir (Iir_Kind_Component_Configuration); - Location_Copy (Res, Comp_Conf); - Set_Parent (Res, Conf); - Set_Component_Name (Res, Get_Component_Name (Comp_Conf)); - -- Keep in the designator list only the non-incrementally - -- bound instances, and only the instances in the current - -- statements parts (vhdl-87 generate issue). - Inst_List := Get_Instantiation_List (Comp_Conf); - Designator_List := Create_Iir_List; - for I in 0 .. Get_Nbr_Elements (Inst_List) - 1 loop - Inst_Name := Get_Nth_Element (Inst_List, I); - Inst := Get_Named_Entity (Inst_Name); - if Get_Component_Configuration (Inst) = Comp_Conf - and then Get_Parent (Inst) = Blk - then - Set_Component_Configuration (Inst, Res); - Append_Element (Designator_List, Inst_Name); - end if; - end loop; - Set_Instantiation_List (Res, Designator_List); - Set_Binding_Indication - (Res, Get_Binding_Indication (Comp_Conf)); - Append (Last_Item, Conf, Res); - end if; - end; - when Iir_Kind_Block_Statement => - declare - Res : Iir_Block_Configuration; - begin - if Get_Block_Block_Configuration (El) = Null_Iir then - Res := Create_Iir (Iir_Kind_Block_Configuration); - Location_Copy (Res, El); - Set_Parent (Res, Conf); - Set_Block_Specification (Res, El); - Append (Last_Item, Conf, Res); - end if; - end; - when Iir_Kind_Generate_Statement => - declare - Res : Iir_Block_Configuration; - Scheme : Iir; - Blk_Config : Iir_Block_Configuration; - Blk_Spec : Iir; - begin - Scheme := Get_Generation_Scheme (El); - Blk_Config := Get_Generate_Block_Configuration (El); - if Blk_Config = Null_Iir then - -- No block configuration for the (implicit) internal - -- block. Create one. - Res := Create_Iir (Iir_Kind_Block_Configuration); - Location_Copy (Res, El); - Set_Parent (Res, Conf); - Set_Block_Specification (Res, El); - Append (Last_Item, Conf, Res); - elsif Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then - Blk_Spec := Strip_Denoting_Name - (Get_Block_Specification (Blk_Config)); - if Get_Kind (Blk_Spec) /= Iir_Kind_Generate_Statement then - -- There are partial configurations. - -- Create a default block configuration. - Res := Create_Iir (Iir_Kind_Block_Configuration); - Location_Copy (Res, El); - Set_Parent (Res, Conf); - Blk_Spec := Create_Iir (Iir_Kind_Indexed_Name); - Location_Copy (Blk_Spec, Res); - Set_Index_List (Blk_Spec, Iir_List_Others); - Set_Base_Name (Blk_Spec, El); - Set_Prefix (Blk_Spec, Build_Simple_Name (El, Res)); - Set_Block_Specification (Res, Blk_Spec); - Append (Last_Item, Conf, Res); - end if; - end if; - end; - - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Psl_Default_Clock - | Iir_Kind_Psl_Declaration - | Iir_Kind_Simple_Simultaneous_Statement => - null; - - when others => - Error_Kind ("canon_block_configuration(3)", El); - end case; - El := Get_Chain (El); - end loop; - - -- 4) Canon component configuration and block configuration (recursion). - El := Get_Configuration_Item_Chain (Conf); - while El /= Null_Iir loop - case Get_Kind (El) is - when Iir_Kind_Block_Configuration => - Canon_Block_Configuration (Top, El); - when Iir_Kind_Component_Configuration => - Canon_Component_Configuration (Top, El); - when others => - Error_Kind ("canon_block_configuration", El); - end case; - El := Get_Chain (El); - end loop; - end Canon_Block_Configuration; - - procedure Canon_Interface_List (Chain : Iir) - is - Inter : Iir; - begin - if Canon_Flag_Expressions then - Inter := Chain; - while Inter /= Null_Iir loop - Canon_Expression (Get_Default_Value (Inter)); - Inter := Get_Chain (Inter); - end loop; - end if; - end Canon_Interface_List; - - procedure Canonicalize (Unit: Iir_Design_Unit) - is - El: Iir; - begin - if False then - -- Canon context clauses. - -- This code is not executed since context clauses are already - -- canonicalized. - El := Get_Context_Items (Unit); - while El /= Null_Iir loop - case Get_Kind (El) is - when Iir_Kind_Use_Clause => - null; - when Iir_Kind_Library_Clause => - null; - when others => - Error_Kind ("canonicalize1", El); - end case; - El := Get_Chain (El); - end loop; - end if; - - El := Get_Library_Unit (Unit); - case Get_Kind (El) is - when Iir_Kind_Entity_Declaration => - Canon_Interface_List (Get_Generic_Chain (El)); - Canon_Interface_List (Get_Port_Chain (El)); - Canon_Declarations (Unit, El, El); - Canon_Concurrent_Stmts (Unit, El); - when Iir_Kind_Architecture_Body => - Canon_Declarations (Unit, El, El); - Canon_Concurrent_Stmts (Unit, El); - when Iir_Kind_Package_Declaration => - Canon_Declarations (Unit, El, Null_Iir); - when Iir_Kind_Package_Body => - Canon_Declarations (Unit, El, Null_Iir); - when Iir_Kind_Configuration_Declaration => - Canon_Declarations (Unit, El, Null_Iir); - Canon_Block_Configuration (Unit, Get_Block_Configuration (El)); - when Iir_Kind_Package_Instantiation_Declaration => - declare - Pkg : constant Iir := - Get_Named_Entity (Get_Uninstantiated_Package_Name (El)); - Hdr : constant Iir := Get_Package_Header (Pkg); - begin - Set_Generic_Map_Aspect_Chain - (El, - Canon_Association_Chain_And_Actuals - (Get_Generic_Chain (Hdr), - Get_Generic_Map_Aspect_Chain (El), El)); - end; - when others => - Error_Kind ("canonicalize2", El); - end case; - end Canonicalize; - --- -- Create a default component configuration for component instantiation --- -- statement INST. --- function Create_Default_Component_Configuration --- (Inst : Iir_Component_Instantiation_Statement; --- Parent : Iir; --- Config_Unit : Iir_Design_Unit) --- return Iir_Component_Configuration --- is --- Res : Iir_Component_Configuration; --- Designator : Iir; --- Comp : Iir_Component_Declaration; --- Bind : Iir; --- Aspect : Iir; --- begin --- Bind := Get_Default_Binding_Indication (Inst); - --- if Bind = Null_Iir then --- -- Component is not bound. --- return Null_Iir; --- end if; - --- Res := Create_Iir (Iir_Kind_Component_Configuration); --- Location_Copy (Res, Inst); --- Set_Parent (Res, Parent); --- Comp := Get_Instantiated_Unit (Inst); - --- Set_Component_Name (Res, Comp); --- -- Create the instantiation list with only one element: INST. --- Designator := Create_Iir (Iir_Kind_Designator_List); --- Append_Element (Designator, Inst); --- Set_Instantiation_List (Res, Designator); - --- Set_Binding_Indication (Res, Bind); --- Aspect := Get_Entity_Aspect (Bind); --- case Get_Kind (Aspect) is --- when Iir_Kind_Entity_Aspect_Entity => --- Add_Dependence (Config_Unit, Get_Entity (Aspect)); --- if Get_Architecture (Aspect) /= Null_Iir then --- raise Internal_Error; --- end if; --- when others => --- Error_Kind ("Create_Default_Component_Configuration", Aspect); --- end case; - --- return Res; --- end Create_Default_Component_Configuration; - - -- Create a default configuration declaration for architecture ARCH. - function Create_Default_Configuration_Declaration - (Arch : Iir_Architecture_Body) - return Iir_Design_Unit - is - Loc : constant Location_Type := Get_Location (Arch); - Config : Iir_Configuration_Declaration; - Res : Iir_Design_Unit; - Blk_Cfg : Iir_Block_Configuration; - begin - Res := Create_Iir (Iir_Kind_Design_Unit); - Set_Location (Res, Loc); - Set_Parent (Res, Get_Parent (Get_Design_Unit (Arch))); - Set_Date_State (Res, Date_Analyze); - Set_Date (Res, Date_Uptodate); - - Config := Create_Iir (Iir_Kind_Configuration_Declaration); - Set_Location (Config, Loc); - Set_Library_Unit (Res, Config); - Set_Design_Unit (Config, Res); - Set_Entity_Name (Config, Get_Entity_Name (Arch)); - Set_Dependence_List (Res, Create_Iir_List); - Add_Dependence (Res, Get_Design_Unit (Get_Entity (Config))); - Add_Dependence (Res, Get_Design_Unit (Arch)); - - Blk_Cfg := Create_Iir (Iir_Kind_Block_Configuration); - Set_Location (Blk_Cfg, Loc); - Set_Parent (Blk_Cfg, Config); - Set_Block_Specification (Blk_Cfg, Arch); - Set_Block_Configuration (Config, Blk_Cfg); - - Canon_Block_Configuration (Res, Blk_Cfg); - - return Res; - end Create_Default_Configuration_Declaration; - -end Canon; diff --git a/canon.ads b/canon.ads deleted file mode 100644 index 574a31824..000000000 --- a/canon.ads +++ /dev/null @@ -1,70 +0,0 @@ --- Canonicalization pass --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Iirs; use Iirs; - -package Canon is - -- If true, a label will be added for statements which do not have a - -- label. - Canon_Flag_Add_Labels : Boolean := False; - - -- If true, canon sequentials statements (processes and subprograms). - Canon_Flag_Sequentials_Stmts : Boolean := False; - - -- If true, canon expressions. - Canon_Flag_Expressions : Boolean := False; - - -- If true, replace 'all' sensitivity list by the explicit list - -- (If true, Canon_Flag_Sequentials_Stmts must be true) - Canon_Flag_All_Sensitivity : Boolean := False; - - -- If true, operands of type array element of a concatenation operator - -- are converted (by an aggregate) into array. - Canon_Concatenation : Boolean := False; - - -- Do canonicalization: - -- Transforms concurrent statements into sensitized process statements - -- (all but component instanciation and block). - -- This computes sensivity list. - -- - -- Association list are completed: - -- * Formal are added. - -- * association are created for formal not associated (actual is open). - -- * an association is created (for block header only). - procedure Canonicalize (Unit: Iir_Design_Unit); - - -- Create a default configuration declaration for architecture ARCH. - function Create_Default_Configuration_Declaration - (Arch : Iir_Architecture_Body) - return Iir_Design_Unit; - - -- Canonicalize a subprogram call. - procedure Canon_Subprogram_Call (Call : Iir); - - -- Compute the sensivity list of EXPR and add it to SENSIVITY_LIST. - -- If IS_TARGET is true, the longuest static prefix of the signal name - -- is not added to the sensitivity list, but other static prefix (such - -- as indexes of an indexed name) are added. - procedure Canon_Extract_Sensitivity - (Expr: Iir; Sensitivity_List: Iir_List; Is_Target: Boolean := False); - - -- Compute the sensitivity list of all-sensitized process PROC. - -- Used for vhdl 08. - function Canon_Extract_Process_Sensitivity - (Proc : Iir_Sensitized_Process_Statement) - return Iir_List; -end Canon; diff --git a/canon_psl.adb b/canon_psl.adb deleted file mode 100644 index 1e1d8de18..000000000 --- a/canon_psl.adb +++ /dev/null @@ -1,43 +0,0 @@ --- Canonicalization pass for PSL. --- Copyright (C) 2009 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with PSL.Nodes; use PSL.Nodes; -with PSL.Errors; use PSL.Errors; -with Canon; use Canon; -with Iirs_Utils; use Iirs_Utils; - -package body Canon_PSL is - -- Version of Canon.Canon_Extract_Sensitivity for PSL nodes. - procedure Canon_Extract_Sensitivity - (Expr: PSL_Node; Sensitivity_List: Iir_List) - is - begin - case Get_Kind (Expr) is - when N_HDL_Expr => - Canon_Extract_Sensitivity (Get_HDL_Node (Expr), Sensitivity_List); - when N_And_Bool - | N_Or_Bool => - Canon_Extract_Sensitivity (Get_Left (Expr), Sensitivity_List); - Canon_Extract_Sensitivity (Get_Right (Expr), Sensitivity_List); - when N_Not_Bool => - Canon_Extract_Sensitivity (Get_Boolean (Expr), Sensitivity_List); - when others => - Error_Kind ("PSL.Canon_extract_Sensitivity", Expr); - end case; - end Canon_Extract_Sensitivity; -end Canon_PSL; diff --git a/canon_psl.ads b/canon_psl.ads deleted file mode 100644 index 3a8c501ac..000000000 --- a/canon_psl.ads +++ /dev/null @@ -1,26 +0,0 @@ --- Canonicalization pass for PSL. --- Copyright (C) 2009 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Types; use Types; -with Iirs; use Iirs; - -package Canon_PSL is - -- Version of Canon.Canon_Extract_Sensitivity for PSL nodes. - procedure Canon_Extract_Sensitivity - (Expr: PSL_Node; Sensitivity_List: Iir_List); -end Canon_PSL; diff --git a/configuration.adb b/configuration.adb deleted file mode 100644 index f570b692e..000000000 --- a/configuration.adb +++ /dev/null @@ -1,614 +0,0 @@ --- Configuration generation. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Libraries; -with Errorout; use Errorout; -with Std_Package; -with Sem_Names; -with Name_Table; use Name_Table; -with Flags; -with Iirs_Utils; use Iirs_Utils; - -package body Configuration is - procedure Add_Design_Concurrent_Stmts (Parent : Iir); - procedure Add_Design_Block_Configuration (Blk : Iir_Block_Configuration); - procedure Add_Design_Aspect (Aspect : Iir; Add_Default : Boolean); - - Current_File_Dependence : Iir_List := Null_Iir_List; - Current_Configuration : Iir_Configuration_Declaration := Null_Iir; - - -- UNIT is a design unit of a configuration declaration. - -- Fill the DESIGN_UNITS table with all design units required to build - -- UNIT. - procedure Add_Design_Unit (Unit : Iir_Design_Unit; From : Iir) - is - List : Iir_List; - El : Iir; - Lib_Unit : Iir; - File : Iir_Design_File; - Prev_File_Dependence : Iir_List; - begin - if Flag_Build_File_Dependence then - File := Get_Design_File (Unit); - if Current_File_Dependence /= Null_Iir_List then - Add_Element (Current_File_Dependence, File); - end if; - end if; - - -- If already in the table, then nothing to do. - if Get_Elab_Flag (Unit) then - return; - end if; - - -- May be enabled to debug dependency construction. - if False then - if From = Null_Iir then - Warning_Msg_Elab (Disp_Node (Unit) & " added", Unit); - else - Warning_Msg_Elab - (Disp_Node (Unit) & " added by " & Disp_Node (From), From); - end if; - end if; - - Set_Elab_Flag (Unit, True); - - Lib_Unit := Get_Library_Unit (Unit); - - if Flag_Build_File_Dependence then - Prev_File_Dependence := Current_File_Dependence; - - if Get_Kind (Lib_Unit) = Iir_Kind_Configuration_Declaration - and then Get_Identifier (Lib_Unit) = Null_Identifier - then - -- Do not add dependence for default configuration. - Current_File_Dependence := Null_Iir_List; - else - File := Get_Design_File (Unit); - Current_File_Dependence := Get_File_Dependence_List (File); - -- Create a list if not yet created. - if Current_File_Dependence = Null_Iir_List then - Current_File_Dependence := Create_Iir_List; - Set_File_Dependence_List (File, Current_File_Dependence); - end if; - end if; - end if; - - if Flag_Load_All_Design_Units then - Libraries.Load_Design_Unit (Unit, From); - end if; - - -- Add packages from depend list. - -- If Flag_Build_File_Dependences is set, add design units of the - -- dependence list are added, because of LRM 11.4 Analysis Order. - -- Note: a design unit may be referenced but unused. - -- (eg: component specification which does not apply). - List := Get_Dependence_List (Unit); - for I in Natural loop - El := Get_Nth_Element (List, I); - exit when El = Null_Iir; - El := Libraries.Find_Design_Unit (El); - if El /= Null_Iir then - Lib_Unit := Get_Library_Unit (El); - if Flag_Build_File_Dependence - or else Get_Kind (Lib_Unit) in Iir_Kinds_Package_Declaration - then - Add_Design_Unit (El, Unit); - end if; - end if; - end loop; - - -- Lib_Unit may have changed. - Lib_Unit := Get_Library_Unit (Unit); - - case Get_Kind (Lib_Unit) is - when Iir_Kind_Package_Declaration => - -- Analyze the package declaration, so that Set_Package below - -- will set the full package (and not a stub). - Libraries.Load_Design_Unit (Unit, From); - Lib_Unit := Get_Library_Unit (Unit); - when Iir_Kind_Package_Instantiation_Declaration => - -- The uninstantiated package is part of the dependency. - null; - when Iir_Kind_Configuration_Declaration => - -- Add entity and architecture. - -- find all sub-configuration - Libraries.Load_Design_Unit (Unit, From); - Lib_Unit := Get_Library_Unit (Unit); - Add_Design_Unit (Get_Design_Unit (Get_Entity (Lib_Unit)), Unit); - declare - Blk : Iir_Block_Configuration; - Prev_Configuration : Iir_Configuration_Declaration; - Arch : Iir; - begin - Prev_Configuration := Current_Configuration; - Current_Configuration := Lib_Unit; - Blk := Get_Block_Configuration (Lib_Unit); - Arch := Get_Block_Specification (Blk); - Add_Design_Block_Configuration (Blk); - Current_Configuration := Prev_Configuration; - Add_Design_Unit (Get_Design_Unit (Arch), Unit); - end; - when Iir_Kind_Architecture_Body => - -- Add entity - -- find all entity/architecture/configuration instantiation - Add_Design_Unit (Get_Design_Unit (Get_Entity (Lib_Unit)), Unit); - Add_Design_Concurrent_Stmts (Lib_Unit); - when Iir_Kind_Entity_Declaration => - null; - when Iir_Kind_Package_Body => - null; - when others => - Error_Kind ("add_design_unit", Lib_Unit); - end case; - - -- Add it in the table, after the dependencies. - Design_Units.Append (Unit); - - -- Restore now the file dependence. - -- Indeed, we may add a package body when we are in a package - -- declaration. However, the later does not depend on the former. - -- The file which depends on the package declaration also depends on - -- the package body. - if Flag_Build_File_Dependence then - Current_File_Dependence := Prev_File_Dependence; - end if; - - if Get_Kind (Lib_Unit) = Iir_Kind_Package_Declaration then - -- Add body (if any). - declare - Bod : Iir_Design_Unit; - begin - Bod := Libraries.Find_Secondary_Unit (Unit, Null_Identifier); - if Get_Need_Body (Lib_Unit) then - if not Flags.Flag_Elaborate_With_Outdated then - -- LIB_UNIT requires a body. - if Bod = Null_Iir then - Error_Msg_Elab ("body of " & Disp_Node (Lib_Unit) - & " was never analyzed", Lib_Unit); - elsif Get_Date (Bod) < Get_Date (Unit) then - Error_Msg_Elab (Disp_Node (Bod) & " is outdated"); - Bod := Null_Iir; - end if; - end if; - else - if Bod /= Null_Iir - and then Get_Date (Bod) < Get_Date (Unit) - then - -- There is a body for LIB_UNIT (which doesn't - -- require it) but it is outdated. - Bod := Null_Iir; - end if; - end if; - if Bod /= Null_Iir then - Set_Package (Get_Library_Unit (Bod), Lib_Unit); - Add_Design_Unit (Bod, Unit); - end if; - end; - end if; - end Add_Design_Unit; - - procedure Add_Design_Concurrent_Stmts (Parent : Iir) - is - Stmt : Iir; - begin - Stmt := Get_Concurrent_Statement_Chain (Parent); - while Stmt /= Null_Iir loop - case Get_Kind (Stmt) is - when Iir_Kind_Component_Instantiation_Statement => - if Is_Entity_Instantiation (Stmt) then - -- Entity or configuration instantiation. - Add_Design_Aspect (Get_Instantiated_Unit (Stmt), True); - end if; - when Iir_Kind_Generate_Statement - | Iir_Kind_Block_Statement => - Add_Design_Concurrent_Stmts (Stmt); - when Iir_Kind_Process_Statement - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Psl_Default_Clock - | Iir_Kind_Psl_Declaration - | Iir_Kind_Simple_Simultaneous_Statement => - null; - when others => - Error_Kind ("add_design_concurrent_stmts(2)", Stmt); - end case; - Stmt := Get_Chain (Stmt); - end loop; - end Add_Design_Concurrent_Stmts; - - procedure Add_Design_Aspect (Aspect : Iir; Add_Default : Boolean) - is - use Libraries; - - Entity : Iir; - Arch : Iir; - Config : Iir; - Id : Name_Id; - Entity_Lib : Iir; - begin - if Aspect = Null_Iir then - return; - end if; - case Get_Kind (Aspect) is - when Iir_Kind_Entity_Aspect_Entity => - -- Add the entity. - Entity_Lib := Get_Entity (Aspect); - Entity := Get_Design_Unit (Entity_Lib); - Add_Design_Unit (Entity, Aspect); - - -- Extract and add the architecture. - Arch := Get_Architecture (Aspect); - if Arch /= Null_Iir then - case Get_Kind (Arch) is - when Iir_Kind_Simple_Name => - Id := Get_Identifier (Arch); - Arch := Load_Secondary_Unit (Entity, Id, Aspect); - if Arch = Null_Iir then - Error_Msg_Elab - ("cannot find architecture " & Name_Table.Image (Id) - & " of " & Disp_Node (Entity_Lib)); - return; - else - Set_Architecture (Aspect, Get_Library_Unit (Arch)); - end if; - when Iir_Kind_Architecture_Body => - Arch := Get_Design_Unit (Arch); - when others => - Error_Kind ("add_design_aspect", Arch); - end case; - else - Arch := Get_Latest_Architecture (Entity_Lib); - if Arch = Null_Iir then - Error_Msg_Elab ("no architecture in library for " - & Disp_Node (Entity_Lib), Aspect); - return; - end if; - Arch := Get_Design_Unit (Arch); - end if; - Load_Design_Unit (Arch, Aspect); - Add_Design_Unit (Arch, Aspect); - - -- Add the default configuration if required. - if Add_Default then - Config := Get_Default_Configuration_Declaration - (Get_Library_Unit (Arch)); - if Config /= Null_Iir then - Add_Design_Unit (Config, Aspect); - end if; - end if; - when Iir_Kind_Entity_Aspect_Configuration => - Add_Design_Unit - (Get_Design_Unit (Get_Configuration (Aspect)), Aspect); - when Iir_Kind_Entity_Aspect_Open => - null; - when others => - Error_Kind ("add_design_aspect", Aspect); - end case; - end Add_Design_Aspect; - - -- Return TRUE is PORT must not be open, and emit an error message only if - -- LOC is not NULL_IIR. - function Check_Open_Port (Port : Iir; Loc : Iir) return Boolean is - begin - case Get_Mode (Port) is - when Iir_In_Mode => - -- LRM 1.1.1.2 Ports - -- A port of mode IN may be unconnected or unassociated only if - -- its declaration includes a default expression. - if Get_Default_Value (Port) = Null_Iir then - if Loc /= Null_Iir then - Error_Msg_Elab - ("IN " & Disp_Node (Port) & " must be connected", Loc); - end if; - return True; - end if; - when Iir_Out_Mode - | Iir_Inout_Mode - | Iir_Buffer_Mode - | Iir_Linkage_Mode => - -- LRM 1.1.1.2 Ports - -- A port of any mode other than IN may be unconnected or - -- unassociated as long as its type is not an unconstrained array - -- type. - if Get_Kind (Get_Type (Port)) in Iir_Kinds_Array_Type_Definition - and then (Get_Constraint_State (Get_Type (Port)) - /= Fully_Constrained) - then - if Loc /= Null_Iir then - Error_Msg_Elab ("unconstrained " & Disp_Node (Port) - & " must be connected", Loc); - end if; - return True; - end if; - when others => - Error_Kind ("check_open_port", Port); - end case; - return False; - end Check_Open_Port; - - procedure Check_Binding_Indication (Conf : Iir) - is - Assoc : Iir; - Conf_Chain : Iir; - Inst_Chain : Iir; - Bind : Iir_Binding_Indication; - Err : Boolean; - Inst : Iir; - Inst_List : Iir_List; - Formal : Iir; - Assoc_1 : Iir; - Actual : Iir; - begin - Bind := Get_Binding_Indication (Conf); - Conf_Chain := Get_Port_Map_Aspect_Chain (Bind); - - Err := False; - -- Note: the assoc chain is already canonicalized. - - -- First pass: check for open associations in configuration. - Assoc := Conf_Chain; - while Assoc /= Null_Iir loop - if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then - Formal := Get_Association_Interface (Assoc); - Err := Err or Check_Open_Port (Formal, Assoc); - if Flags.Warn_Binding and then not Get_Artificial_Flag (Assoc) then - Warning_Msg_Elab - (Disp_Node (Formal) & " of " & Disp_Node (Get_Parent (Formal)) - & " is not bound", Assoc); - Warning_Msg_Elab - ("(in " & Disp_Node (Current_Configuration) & ")", - Current_Configuration); - end if; - end if; - Assoc := Get_Chain (Assoc); - end loop; - if Err then - return; - end if; - - -- Second pass: check for port connected to open in instantiation. - Inst_List := Get_Instantiation_List (Conf); - for I in Natural loop - Inst := Get_Nth_Element (Inst_List, I); - exit when Inst = Null_Iir; - Inst := Get_Named_Entity (Inst); - Err := False; - - -- Mark component ports not associated. - Inst_Chain := Get_Port_Map_Aspect_Chain (Inst); - Assoc := Inst_Chain; - while Assoc /= Null_Iir loop - if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then - Formal := Get_Association_Interface (Assoc); - Set_Open_Flag (Formal, True); - Err := True; - end if; - Assoc := Get_Chain (Assoc); - end loop; - - -- If there is any component port open, search them in the - -- configuration. - if Err then - Assoc := Conf_Chain; - while Assoc /= Null_Iir loop - Formal := Get_Association_Interface (Assoc); - if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then - Actual := Null_Iir; - else - Actual := Get_Actual (Assoc); - Actual := Sem_Names.Name_To_Object (Actual); - if Actual /= Null_Iir then - Actual := Get_Object_Prefix (Actual); - end if; - end if; - if Actual /= Null_Iir - and then Get_Open_Flag (Actual) - and then Check_Open_Port (Formal, Null_Iir) - then - -- For a better message, find the location. - Assoc_1 := Inst_Chain; - while Assoc_1 /= Null_Iir loop - if Get_Kind (Assoc_1) = Iir_Kind_Association_Element_Open - and then Actual = Get_Association_Interface (Assoc_1) - then - Err := Check_Open_Port (Formal, Assoc_1); - exit; - end if; - Assoc_1 := Get_Chain (Assoc_1); - end loop; - end if; - Assoc := Get_Chain (Assoc); - end loop; - - -- Clear open flag. - Assoc := Inst_Chain; - while Assoc /= Null_Iir loop - if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then - Formal := Get_Association_Interface (Assoc); - Set_Open_Flag (Formal, False); - end if; - Assoc := Get_Chain (Assoc); - end loop; - end if; - end loop; - end Check_Binding_Indication; - - -- CONF is either a configuration specification or a component - -- configuration. - -- If ADD_DEFAULT is true, then the default configuration for the design - -- binding must be added if required. - procedure Add_Design_Binding_Indication (Conf : Iir; Add_Default : Boolean) - is - Bind : constant Iir_Binding_Indication := Get_Binding_Indication (Conf); - Inst : Iir; - begin - if Bind = Null_Iir then - if Flags.Warn_Binding then - Inst := Get_First_Element (Get_Instantiation_List (Conf)); - Warning_Msg_Elab - (Disp_Node (Inst) & " is not bound", Conf); - Warning_Msg_Elab - ("(in " & Disp_Node (Current_Configuration) & ")", - Current_Configuration); - end if; - return; - end if; - Check_Binding_Indication (Conf); - Add_Design_Aspect (Get_Entity_Aspect (Bind), Add_Default); - end Add_Design_Binding_Indication; - - procedure Add_Design_Block_Configuration (Blk : Iir_Block_Configuration) - is - Item : Iir; - Sub_Config : Iir; - begin - if Blk = Null_Iir then - return; - end if; - Item := Get_Configuration_Item_Chain (Blk); - while Item /= Null_Iir loop - case Get_Kind (Item) is - when Iir_Kind_Configuration_Specification => - Add_Design_Binding_Indication (Item, True); - when Iir_Kind_Component_Configuration => - Sub_Config := Get_Block_Configuration (Item); - Add_Design_Binding_Indication (Item, Sub_Config = Null_Iir); - Add_Design_Block_Configuration (Sub_Config); - when Iir_Kind_Block_Configuration => - Add_Design_Block_Configuration (Item); - when others => - Error_Kind ("add_design_block_configuration", Item); - end case; - Item := Get_Chain (Item); - end loop; - end Add_Design_Block_Configuration; - - -- elaboration of a design hierarchy: - -- creates a list of design unit. - -- - -- find top configuration (may be a default one), add it to the list. - -- For each element of the list: - -- add direct dependences (packages, entity, arch) if not in the list - -- for architectures and configuration: find instantiations and add - -- corresponding configurations - function Configure (Primary_Id : Name_Id; Secondary_Id : Name_Id) - return Iir - is - use Libraries; - - Unit : Iir_Design_Unit; - Lib_Unit : Iir; - Top : Iir; - begin - Unit := Find_Primary_Unit (Work_Library, Primary_Id); - if Unit = Null_Iir then - Error_Msg_Elab ("cannot find entity or configuration " - & Name_Table.Image (Primary_Id)); - return Null_Iir; - end if; - Lib_Unit := Get_Library_Unit (Unit); - case Get_Kind (Lib_Unit) is - when Iir_Kind_Entity_Declaration => - Load_Design_Unit (Unit, Null_Iir); - Lib_Unit := Get_Library_Unit (Unit); - if Secondary_Id /= Null_Identifier then - Unit := Find_Secondary_Unit (Unit, Secondary_Id); - if Unit = Null_Iir then - Error_Msg_Elab - ("cannot find architecture " - & Name_Table.Image (Secondary_Id) - & " of " & Disp_Node (Lib_Unit)); - return Null_Iir; - end if; - else - declare - Arch_Unit : Iir_Architecture_Body; - begin - Arch_Unit := Get_Latest_Architecture (Lib_Unit); - if Arch_Unit = Null_Iir then - Error_Msg_Elab - (Disp_Node (Lib_Unit) - & " has no architecture in library " - & Name_Table.Image (Get_Identifier (Work_Library))); - return Null_Iir; - end if; - Unit := Get_Design_Unit (Arch_Unit); - end; - end if; - Load_Design_Unit (Unit, Lib_Unit); - if Nbr_Errors /= 0 then - return Null_Iir; - end if; - Lib_Unit := Get_Library_Unit (Unit); - Top := Get_Default_Configuration_Declaration (Lib_Unit); - if Top = Null_Iir then - -- No default configuration for this architecture. - raise Internal_Error; - end if; - when Iir_Kind_Configuration_Declaration => - Top := Unit; - when others => - Error_Msg_Elab (Name_Table.Image (Primary_Id) - & " is neither an entity nor a configuration"); - return Null_Iir; - end case; - - Set_Elab_Flag (Std_Package.Std_Standard_Unit, True); - - Add_Design_Unit (Top, Null_Iir); - return Top; - end Configure; - - procedure Check_Entity_Declaration_Top (Entity : Iir_Entity_Declaration) - is - Has_Error : Boolean := False; - - procedure Error (Msg : String; Loc : Iir) is - begin - if not Has_Error then - Error_Msg_Elab - (Disp_Node (Entity) & " cannot be at the top of a design"); - Has_Error := True; - end if; - Error_Msg_Elab (Msg, Loc); - end Error; - - El : Iir; - begin - -- Check generics. - El := Get_Generic_Chain (Entity); - while El /= Null_Iir loop - if Get_Default_Value (El) = Null_Iir then - Error ("(" & Disp_Node (El) & " has no default value)", El); - end if; - El := Get_Chain (El); - end loop; - - -- Check port. - El := Get_Port_Chain (Entity); - while El /= Null_Iir loop - if not Is_Fully_Constrained_Type (Get_Type (El)) - and then Get_Default_Value (El) = Null_Iir - then - Error ("(" & Disp_Node (El) - & " is unconstrained and has no default value)", El); - end if; - El := Get_Chain (El); - end loop; - end Check_Entity_Declaration_Top; -end Configuration; diff --git a/configuration.ads b/configuration.ads deleted file mode 100644 index 0a19a23c2..000000000 --- a/configuration.ads +++ /dev/null @@ -1,55 +0,0 @@ --- Configuration generation. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Types; use Types; -with Iirs; use Iirs; -with GNAT.Table; - -package Configuration is - package Design_Units is new GNAT.Table - (Table_Component_Type => Iir_Design_Unit, - Table_Index_Type => Natural, - Table_Low_Bound => 1, - Table_Initial => 16, - Table_Increment => 100); - - -- Get the top configuration to build a design hierarchy whose top is - -- PRIMARY + SECONDARY. - -- PRIMARY must designate a configuration declaration or an entity - -- declaration. In the last case, SECONDARY must be null_identifier or - -- designates an architecture declaration. - -- - -- creates a list of design unit. - -- and return the top configuration. - -- Note: this set the Elab_Flag on units. - function Configure (Primary_Id : Name_Id; Secondary_Id : Name_Id) - return Iir; - - -- Add design unit UNIT (with its dependences) in the design_units table. - procedure Add_Design_Unit (Unit : Iir_Design_Unit; From : Iir); - - -- If set, all design units (even package bodies) are loaded. - Flag_Load_All_Design_Units : Boolean := True; - - Flag_Build_File_Dependence : Boolean := False; - - -- Check if ENTITY can be at the top of a hierarchy, ie: - -- ENTITY has no generics or all generics have a default expression - -- ENTITY has no ports or all ports type are constrained. - -- If not, emit a elab error message. - procedure Check_Entity_Declaration_Top (Entity : Iir_Entity_Declaration); -end Configuration; diff --git a/disp_tree.adb b/disp_tree.adb deleted file mode 100644 index fbaaa939b..000000000 --- a/disp_tree.adb +++ /dev/null @@ -1,511 +0,0 @@ --- Node displaying (for debugging). --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - --- Display trees in raw form. Mainly used for debugging. - -with Ada.Text_IO; use Ada.Text_IO; -with Name_Table; -with Str_Table; -with Tokens; -with Errorout; -with Files_Map; -with PSL.Dump_Tree; -with Nodes_Meta; - --- Do not add a use clause for iirs_utils, as it may crash for ill-formed --- trees, which is annoying while debugging. - -package body Disp_Tree is - -- function Is_Anonymous_Type_Definition (Def : Iir) return Boolean - -- renames Iirs_Utils.Is_Anonymous_Type_Definition; - - procedure Disp_Iir (N : Iir; - Indent : Natural := 1; - Flat : Boolean := False); - procedure Disp_Header (N : Iir); - - procedure Disp_Tree_List_Flat (Tree_List: Iir_List; Tab: Natural); - pragma Unreferenced (Disp_Tree_List_Flat); - - procedure Put_Indent (Tab: Natural) is - Blanks : constant String (1 .. 2 * Tab) := (others => ' '); - begin - Put (Blanks); - end Put_Indent; - - procedure Disp_Iir_Number (Node: Iir) - is - Res : String (1 .. 10) := " ]"; - N : Int32 := Int32 (Node); - begin - for I in reverse 2 .. 9 loop - Res (I) := Character'Val (Character'Pos ('0') + (N mod 10)); - N := N / 10; - if N = 0 then - Res (I - 1) := '['; - Put (Res (I - 1 .. Res'Last)); - return; - end if; - end loop; - Put (Res); - end Disp_Iir_Number; - - -- For iir. - - procedure Disp_Tree_Flat (Tree: Iir; Tab: Natural) is - begin - Disp_Iir (Tree, Tab, True); - end Disp_Tree_Flat; - - procedure Disp_Iir_List - (Tree_List : Iir_List; Tab : Natural := 0; Flat : Boolean := False) - is - El: Iir; - begin - if Tree_List = Null_Iir_List then - Put_Line ("null-list"); - elsif Tree_List = Iir_List_All then - Put_Line ("list-all"); - elsif Tree_List = Iir_List_Others then - Put_Line ("list-others"); - else - New_Line; - for I in Natural loop - El := Get_Nth_Element (Tree_List, I); - exit when El = Null_Iir; - Put_Indent (Tab); - Disp_Iir (El, Tab + 1, Flat); - end loop; - end if; - end Disp_Iir_List; - - procedure Disp_Chain - (Tree_Chain: Iir; Indent: Natural; Flat : Boolean := False) - is - El: Iir; - begin - New_Line; - El := Tree_Chain; - while El /= Null_Iir loop - Put_Indent (Indent); - Disp_Iir (El, Indent + 1, Flat); - El := Get_Chain (El); - end loop; - end Disp_Chain; - - procedure Disp_Tree_Flat_Chain (Tree_Chain: Iir; Tab: Natural) - is - El: Iir; - begin - El := Tree_Chain; - while El /= Null_Iir loop - Disp_Iir (El, Tab, True); - El := Get_Chain (El); - end loop; - end Disp_Tree_Flat_Chain; - pragma Unreferenced (Disp_Tree_Flat_Chain); - - procedure Disp_Tree_List_Flat (Tree_List: Iir_List; Tab: Natural) - is - El: Iir; - begin - if Tree_List = Null_Iir_List then - Put_Indent (Tab); - Put_Line (" null-list"); - elsif Tree_List = Iir_List_All then - Put_Indent (Tab); - Put_Line (" list-all"); - elsif Tree_List = Iir_List_Others then - Put_Indent (Tab); - Put_Line (" list-others"); - else - for I in Natural loop - El := Get_Nth_Element (Tree_List, I); - exit when El = Null_Iir; - Disp_Tree_Flat (El, Tab); - end loop; - end if; - end Disp_Tree_List_Flat; - - function Image_Name_Id (Ident: Name_Id) return String - is - use Name_Table; - begin - if Ident /= Null_Identifier then - Image (Ident); - return ''' & Name_Buffer (1 .. Name_Length) & '''; - else - return ""; - end if; - end Image_Name_Id; - - function Image_Iir_Staticness (Static: Iir_Staticness) return String is - begin - case Static is - when Unknown => - return "???"; - when None => - return "none"; - when Globally => - return "global"; - when Locally => - return "local"; - end case; - end Image_Iir_Staticness; - - function Image_Boolean (Bool : Boolean) return String is - begin - if Bool then - return "true"; - else - return "false"; - end if; - end Image_Boolean; - - function Image_Iir_Delay_Mechanism (Mech : Iir_Delay_Mechanism) - return String is - begin - case Mech is - when Iir_Inertial_Delay => - return "inertial"; - when Iir_Transport_Delay => - return "transport"; - end case; - end Image_Iir_Delay_Mechanism; - - function Image_Iir_Lexical_Layout_Type (V : Iir_Lexical_Layout_Type) - return String is - begin - if (V and Iir_Lexical_Has_Mode) /= 0 then - return " +mode" - & Image_Iir_Lexical_Layout_Type (V and not Iir_Lexical_Has_Mode); - elsif (V and Iir_Lexical_Has_Class) /= 0 then - return " +class" - & Image_Iir_Lexical_Layout_Type (V and not Iir_Lexical_Has_Class); - elsif (V and Iir_Lexical_Has_Type) /= 0 then - return " +type" - & Image_Iir_Lexical_Layout_Type (V and not Iir_Lexical_Has_Type); - else - return ""; - end if; - end Image_Iir_Lexical_Layout_Type; - - function Image_Iir_Mode (Mode : Iir_Mode) return String is - begin - case Mode is - when Iir_Unknown_Mode => - return "???"; - when Iir_Linkage_Mode => - return "linkage"; - when Iir_Buffer_Mode => - return "buffer"; - when Iir_Out_Mode => - return "out"; - when Iir_Inout_Mode => - return "inout"; - when Iir_In_Mode => - return "in"; - end case; - end Image_Iir_Mode; - - function Image_Iir_Signal_Kind (Kind : Iir_Signal_Kind) return String is - begin - case Kind is - when Iir_No_Signal_Kind => - return "no"; - when Iir_Register_Kind => - return "register"; - when Iir_Bus_Kind => - return "bus"; - end case; - end Image_Iir_Signal_Kind; - - function Image_Iir_Pure_State (State : Iir_Pure_State) return String is - begin - case State is - when Pure => - return "pure"; - when Impure => - return "impure"; - when Maybe_Impure => - return "maybe_impure"; - when Unknown => - return "unknown"; - end case; - end Image_Iir_Pure_State; - - function Image_Iir_All_Sensitized (Sig : Iir_All_Sensitized) - return String is - begin - case Sig is - when Unknown => - return "???"; - when No_Signal => - return "no_signal"; - when Read_Signal => - return "read_signal"; - when Invalid_Signal => - return "invalid_signal"; - end case; - end Image_Iir_All_Sensitized; - - function Image_Iir_Constraint (Const : Iir_Constraint) return String is - begin - case Const is - when Unconstrained => - return "unconstrained"; - when Partially_Constrained => - return "partially constrained"; - when Fully_Constrained => - return "fully constrained"; - end case; - end Image_Iir_Constraint; - - function Image_Date_State_Type (State : Date_State_Type) return String is - begin - case State is - when Date_Extern => - return "extern"; - when Date_Disk => - return "disk"; - when Date_Parse => - return "parse"; - when Date_Analyze => - return "analyze"; - end case; - end Image_Date_State_Type; - - function Image_Tri_State_Type (State : Tri_State_Type) return String is - begin - case State is - when True => - return "true"; - when False => - return "false"; - when Unknown => - return "unknown"; - end case; - end Image_Tri_State_Type; - - function Image_Time_Stamp_Id (Id : Time_Stamp_Id) return String - renames Files_Map.Get_Time_Stamp_String; - - function Image_Iir_Predefined_Functions (F : Iir_Predefined_Functions) - return String is - begin - return Iir_Predefined_Functions'Image (F); - end Image_Iir_Predefined_Functions; - - function Image_String_Id (S : String_Id) return String - renames Str_Table.Image; - - procedure Disp_PSL_Node (N : PSL_Node; Indent : Natural) is - begin - Put_Indent (Indent); - PSL.Dump_Tree.Dump_Tree (N, True); - end Disp_PSL_Node; - - procedure Disp_PSL_NFA (N : PSL_NFA; Indent : Natural) is - begin - null; - end Disp_PSL_NFA; - - function Image_Location_Type (Loc : Location_Type) return String is - begin - return Errorout.Get_Location_Str (Loc); - end Image_Location_Type; - - function Image_Iir_Direction (Dir : Iir_Direction) return String is - begin - case Dir is - when Iir_To => - return "to"; - when Iir_Downto => - return "downto"; - end case; - end Image_Iir_Direction; - - function Image_Token_Type (Tok : Tokens.Token_Type) return String - renames Tokens.Image; - - procedure Header (Str : String; Indent : Natural) is - begin - Put_Indent (Indent); - Put (Str); - Put (": "); - end Header; - - procedure Disp_Header (N : Iir) - is - use Nodes_Meta; - K : Iir_Kind; - begin - if N = Null_Iir then - Put_Line ("*null*"); - return; - end if; - - K := Get_Kind (N); - Put (Get_Iir_Image (K)); - if Has_Identifier (K) then - Put (' '); - Put (Image_Name_Id (Get_Identifier (N))); - end if; - - Put (' '); - Disp_Iir_Number (N); - - New_Line; - end Disp_Header; - - procedure Disp_Iir (N : Iir; - Indent : Natural := 1; - Flat : Boolean := False) - is - Sub_Indent : constant Natural := Indent + 1; - begin - Disp_Header (N); - - if Flat or else N = Null_Iir then - return; - end if; - - Header ("location", Indent); - Put_Line (Image_Location_Type (Get_Location (N))); - - -- Protect against infinite recursions. - if Indent > 20 then - Put_Indent (Indent); - Put_Line ("..."); - return; - end if; - - declare - use Nodes_Meta; - Fields : constant Fields_Array := Get_Fields (Get_Kind (N)); - F : Fields_Enum; - begin - for I in Fields'Range loop - F := Fields (I); - Header (Get_Field_Image (F), Indent); - case Get_Field_Type (F) is - when Type_Iir => - case Get_Field_Attribute (F) is - when Attr_None => - Disp_Iir (Get_Iir (N, F), Sub_Indent); - when Attr_Ref => - Disp_Iir (Get_Iir (N, F), Sub_Indent, True); - when Attr_Maybe_Ref => - Disp_Iir (Get_Iir (N, F), Sub_Indent, Get_Is_Ref (N)); - when Attr_Chain => - Disp_Chain (Get_Iir (N, F), Sub_Indent); - when Attr_Chain_Next => - Disp_Iir_Number (Get_Iir (N, F)); - New_Line; - when Attr_Of_Ref => - raise Internal_Error; - end case; - when Type_Iir_List => - Disp_Iir_List (Get_Iir_List (N, F), Sub_Indent, - Get_Field_Attribute (F) = Attr_Of_Ref); - when Type_PSL_NFA => - Disp_PSL_NFA (Get_PSL_NFA (N, F), Sub_Indent); - when Type_String_Id => - Put_Line (Image_String_Id (Get_String_Id (N, F))); - when Type_PSL_Node => - Disp_PSL_Node (Get_PSL_Node (N, F), Sub_Indent); - when Type_Source_Ptr => - Put_Line (Source_Ptr'Image (Get_Source_Ptr (N, F))); - when Type_Date_Type => - Put_Line (Date_Type'Image (Get_Date_Type (N, F))); - when Type_Base_Type => - Put_Line (Base_Type'Image (Get_Base_Type (N, F))); - when Type_Iir_Constraint => - Put_Line (Image_Iir_Constraint - (Get_Iir_Constraint (N, F))); - when Type_Iir_Mode => - Put_Line (Image_Iir_Mode (Get_Iir_Mode (N, F))); - when Type_Iir_Index32 => - Put_Line (Iir_Index32'Image (Get_Iir_Index32 (N, F))); - when Type_Iir_Int64 => - Put_Line (Iir_Int64'Image (Get_Iir_Int64 (N, F))); - when Type_Boolean => - Put_Line (Image_Boolean - (Get_Boolean (N, F))); - when Type_Iir_Staticness => - Put_Line (Image_Iir_Staticness - (Get_Iir_Staticness (N, F))); - when Type_Date_State_Type => - Put_Line (Image_Date_State_Type - (Get_Date_State_Type (N, F))); - when Type_Iir_All_Sensitized => - Put_Line (Image_Iir_All_Sensitized - (Get_Iir_All_Sensitized (N, F))); - when Type_Iir_Signal_Kind => - Put_Line (Image_Iir_Signal_Kind - (Get_Iir_Signal_Kind (N, F))); - when Type_Tri_State_Type => - Put_Line (Image_Tri_State_Type - (Get_Tri_State_Type (N, F))); - when Type_Iir_Pure_State => - Put_Line (Image_Iir_Pure_State - (Get_Iir_Pure_State (N, F))); - when Type_Iir_Delay_Mechanism => - Put_Line (Image_Iir_Delay_Mechanism - (Get_Iir_Delay_Mechanism (N, F))); - when Type_Iir_Lexical_Layout_Type => - Put_Line (Image_Iir_Lexical_Layout_Type - (Get_Iir_Lexical_Layout_Type (N, F))); - when Type_Iir_Predefined_Functions => - Put_Line (Image_Iir_Predefined_Functions - (Get_Iir_Predefined_Functions (N, F))); - when Type_Iir_Direction => - Put_Line (Image_Iir_Direction - (Get_Iir_Direction (N, F))); - when Type_Location_Type => - Put_Line (Image_Location_Type - (Get_Location_Type (N, F))); - when Type_Iir_Int32 => - Put_Line (Iir_Int32'Image (Get_Iir_Int32 (N, F))); - when Type_Int32 => - Put_Line (Int32'Image (Get_Int32 (N, F))); - when Type_Iir_Fp64 => - Put_Line (Iir_Fp64'Image (Get_Iir_Fp64 (N, F))); - when Type_Time_Stamp_Id => - Put_Line (Image_Time_Stamp_Id - (Get_Time_Stamp_Id (N, F))); - when Type_Token_Type => - Put_Line (Image_Token_Type (Get_Token_Type (N, F))); - when Type_Name_Id => - Put_Line (Image_Name_Id (Get_Name_Id (N, F))); - end case; - end loop; - end; - end Disp_Iir; - - procedure Disp_Tree_For_Psl (N : Int32) is - begin - Disp_Tree_Flat (Iir (N), 1); - end Disp_Tree_For_Psl; - - procedure Disp_Tree (Tree : Iir; - Flat : Boolean := false) is - begin - Disp_Iir (Tree, 1, Flat); - end Disp_Tree; -end Disp_Tree; diff --git a/disp_tree.ads b/disp_tree.ads deleted file mode 100644 index 94b1d29e3..000000000 --- a/disp_tree.ads +++ /dev/null @@ -1,27 +0,0 @@ --- Node displaying (for debugging). --- Copyright (C) 2002, 2003, 2004, 2005, 2009 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Types; use Types; -with Iirs; use Iirs; - -package Disp_Tree is - -- Disp TREE recursively. - procedure Disp_Tree (Tree : Iir; - Flat : Boolean := False); - - procedure Disp_Tree_For_Psl (N : Int32); -end Disp_Tree; diff --git a/disp_vhdl.adb b/disp_vhdl.adb deleted file mode 100644 index 73a8e420f..000000000 --- a/disp_vhdl.adb +++ /dev/null @@ -1,3247 +0,0 @@ --- VHDL regeneration from internal nodes. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - --- Re-print a tree as VHDL sources. Except for comments and parenthesis, the --- sequence of tokens displayed is the same as the sequence of tokens in the --- input file. If parenthesis are kept by the parser, the only differences --- are comments and layout. -with GNAT.OS_Lib; -with Std_Package; -with Flags; use Flags; -with Errorout; use Errorout; -with Iirs_Utils; use Iirs_Utils; -with Name_Table; -with Std_Names; -with Tokens; -with PSL.Nodes; -with PSL.Prints; -with PSL.NFAs; - -package body Disp_Vhdl is - - subtype Count is Positive; - - Col : Count := 1; - - IO_Error : exception; - - -- Disp the name of DECL. - procedure Disp_Name_Of (Decl: Iir); - - -- Indentation for nested declarations and statements. - Indentation: constant Count := 2; - - -- Line length (used to try to have a nice display). - Line_Length : constant Count := 80; - - -- If True, display extra parenthesis to make priority of operators - -- explicit. - Flag_Parenthesis : constant Boolean := False; - - -- If set, disp after a string literal the type enclosed into brackets. - Disp_String_Literal_Type: constant Boolean := False; - - -- If set, disp position number of associations - --Disp_Position_Number: constant Boolean := False; - --- procedure Disp_Tab (Tab: Natural) is --- Blanks : String (1 .. Tab) := (others => ' '); --- begin --- Put (Blanks); --- end Disp_Tab; - - procedure Disp_Type (A_Type: Iir); - procedure Disp_Nature (Nature : Iir); - procedure Disp_Range (Rng : Iir); - - procedure Disp_Concurrent_Statement (Stmt: Iir); - procedure Disp_Concurrent_Statement_Chain (Parent: Iir; Indent : Count); - procedure Disp_Declaration_Chain (Parent : Iir; Indent: Count); - procedure Disp_Process_Statement (Process: Iir); - procedure Disp_Sequential_Statements (First : Iir); - procedure Disp_Choice (Choice: in out Iir); - procedure Disp_Association_Chain (Chain : Iir); - procedure Disp_Block_Configuration - (Block: Iir_Block_Configuration; Indent: Count); - procedure Disp_Subprogram_Declaration (Subprg: Iir); - procedure Disp_Binding_Indication (Bind : Iir; Indent : Count); - procedure Disp_Subtype_Indication (Def : Iir; Full_Decl : Boolean := False); - procedure Disp_Parametered_Attribute (Name : String; Expr : Iir); - - procedure Put (Str : String) - is - use GNAT.OS_Lib; - Len : constant Natural := Str'Length; - begin - if Write (Standout, Str'Address, Len) /= Len then - raise IO_Error; - end if; - Col := Col + Len; - end Put; - - procedure Put (C : Character) is - begin - Put ((1 => C)); - end Put; - - procedure New_Line is - begin - Put (ASCII.LF); - Col := 1; - end New_Line; - - procedure Put_Line (Str : String) is - begin - Put (Str); - New_Line; - end Put_Line; - - procedure Set_Col (P : Count) is - begin - if Col = P then - return; - end if; - if Col >= P then - New_Line; - end if; - Put ((Col .. P - 1 => ' ')); - end Set_Col; - - procedure Disp_Ident (Id: Name_Id) is - begin - Put (Name_Table.Image (Id)); - end Disp_Ident; - - procedure Disp_Identifier (Node : Iir) - is - Ident : Name_Id; - begin - Ident := Get_Identifier (Node); - if Ident /= Null_Identifier then - Disp_Ident (Ident); - else - Put (""); - end if; - end Disp_Identifier; - - procedure Disp_Character_Literal (Lit: Iir_Character_Literal) is - begin - Put (''' & Name_Table.Get_Character (Get_Identifier (Lit)) & '''); - end Disp_Character_Literal; - - procedure Disp_Function_Name (Func: Iir) - is - use Name_Table; - use Std_Names; - Id: Name_Id; - begin - Id := Get_Identifier (Func); - case Id is - when Name_Id_Operators - | Name_Word_Operators - | Name_Xnor - | Name_Shift_Operators => - Put (""""); - Put (Image (Id)); - Put (""""); - when others => - Disp_Ident (Id); - end case; - end Disp_Function_Name; - - -- Disp the name of DECL. - procedure Disp_Name_Of (Decl: Iir) is - begin - case Get_Kind (Decl) is - when Iir_Kind_Component_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Type_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Element_Declaration - | Iir_Kind_Record_Element_Constraint - | Iir_Kind_Package_Declaration - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_Non_Object_Alias_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Library_Declaration - | Iir_Kind_Unit_Declaration - | Iir_Kind_Nature_Declaration - | Iir_Kind_Terminal_Declaration - | Iir_Kinds_Quantity_Declaration - | Iir_Kind_Group_Template_Declaration - | Iir_Kind_Character_Literal - | Iir_Kinds_Process_Statement => - Disp_Identifier (Decl); - when Iir_Kind_Anonymous_Type_Declaration => - Put ('<'); - Disp_Ident (Get_Identifier (Decl)); - Put ('>'); - when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration => - Disp_Function_Name (Decl); - when Iir_Kind_Procedure_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - Disp_Identifier (Decl); - when Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Physical_Type_Definition - | Iir_Kind_Record_Type_Definition - | Iir_Kind_Protected_Type_Declaration => - -- Used for 'end' DECL_NAME. - Disp_Identifier (Get_Type_Declarator (Decl)); - when Iir_Kind_Component_Instantiation_Statement => - Disp_Ident (Get_Label (Decl)); - when Iir_Kind_Design_Unit => - Disp_Name_Of (Get_Library_Unit (Decl)); - when Iir_Kind_Enumeration_Literal - | Iir_Kind_Simple_Name => - Disp_Identifier (Decl); - when Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement => - declare - Ident : constant Name_Id := Get_Label (Decl); - begin - if Ident /= Null_Identifier then - Disp_Ident (Ident); - else - Put (""); - end if; - end; - when Iir_Kind_Package_Body => - Disp_Identifier (Get_Package (Decl)); - when Iir_Kind_Procedure_Body - | Iir_Kind_Function_Body => - Disp_Function_Name (Get_Subprogram_Specification (Decl)); - when Iir_Kind_Protected_Type_Body => - Disp_Identifier - (Get_Type_Declarator (Get_Protected_Type_Declaration (Decl))); - when others => - Error_Kind ("disp_name_of", Decl); - end case; - end Disp_Name_Of; - - procedure Disp_Name (Name: Iir) is - begin - case Get_Kind (Name) is - when Iir_Kind_Selected_By_All_Name => - Disp_Name (Get_Prefix (Name)); - Put (".all"); - when Iir_Kind_Dereference => - Disp_Name (Get_Prefix (Name)); - Put (".all"); - when Iir_Kind_Simple_Name - | Iir_Kind_Character_Literal => - Put (Iirs_Utils.Image_Identifier (Name)); - when Iir_Kind_Operator_Symbol => - Disp_Function_Name (Name); - when Iir_Kind_Selected_Name => - Disp_Name (Get_Prefix (Name)); - Put ("."); - Disp_Function_Name (Name); - when Iir_Kind_Parenthesis_Name => - Disp_Name (Get_Prefix (Name)); - Disp_Association_Chain (Get_Association_Chain (Name)); - when Iir_Kind_Base_Attribute => - Disp_Name (Get_Prefix (Name)); - Put ("'base"); - when Iir_Kind_Type_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Enumeration_Literal - | Iir_Kind_Unit_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kinds_Interface_Object_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Terminal_Declaration - | Iir_Kind_Component_Declaration - | Iir_Kind_Group_Template_Declaration => - Disp_Name_Of (Name); - when Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute => - Disp_Range (Name); - when others => - Error_Kind ("disp_name", Name); - end case; - end Disp_Name; - - procedure Disp_Range (Rng : Iir) is - begin - case Get_Kind (Rng) is - when Iir_Kind_Range_Expression => - declare - Origin : constant Iir := Get_Range_Origin (Rng); - begin - if Origin /= Null_Iir then - Disp_Expression (Origin); - else - Disp_Expression (Get_Left_Limit (Rng)); - if Get_Direction (Rng) = Iir_To then - Put (" to "); - else - Put (" downto "); - end if; - Disp_Expression (Get_Right_Limit (Rng)); - end if; - end; - when Iir_Kind_Range_Array_Attribute => - Disp_Parametered_Attribute ("range", Rng); - when Iir_Kind_Reverse_Range_Array_Attribute => - Disp_Parametered_Attribute ("reverse_range", Rng); - when Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name => - Disp_Name (Rng); - when others => - Disp_Subtype_Indication (Rng); - -- Disp_Name_Of (Get_Type_Declarator (Decl)); - end case; - end Disp_Range; - - procedure Disp_After_End (Decl : Iir; Name : String) is - begin - if Get_End_Has_Reserved_Id (Decl) then - Put (' '); - Put (Name); - end if; - if Get_End_Has_Identifier (Decl) then - Put (' '); - Disp_Name_Of (Decl); - end if; - Put (';'); - New_Line; - end Disp_After_End; - - procedure Disp_End (Decl : Iir; Name : String) is - begin - Put ("end"); - Disp_After_End (Decl, Name); - end Disp_End; - - procedure Disp_End_Label (Stmt : Iir; Name : String) is - begin - Put ("end"); - Put (' '); - Put (Name); - if Get_End_Has_Identifier (Stmt) then - Put (' '); - Disp_Ident (Get_Label (Stmt)); - end if; - Put (';'); - New_Line; - end Disp_End_Label; - - procedure Disp_Use_Clause (Clause: Iir_Use_Clause) - is - Name : Iir; - begin - Put ("use "); - Name := Clause; - loop - Disp_Name (Get_Selected_Name (Name)); - Name := Get_Use_Clause_Chain (Name); - exit when Name = Null_Iir; - Put (", "); - end loop; - Put_Line (";"); - end Disp_Use_Clause; - - -- Disp the resolution function (if any) of type definition DEF. - procedure Disp_Resolution_Indication (Subtype_Def: Iir) - is - procedure Inner (Ind : Iir) is - begin - case Get_Kind (Ind) is - when Iir_Kinds_Denoting_Name => - Disp_Name (Ind); - when Iir_Kind_Array_Element_Resolution => - Put ("("); - Inner (Get_Resolution_Indication (Ind)); - Put (")"); - when others => - Error_Kind ("disp_resolution_indication", Ind); - end case; - end Inner; - - Ind : Iir; - begin - case Get_Kind (Subtype_Def) is - when Iir_Kind_Access_Subtype_Definition => - -- No resolution indication on access subtype. - return; - when others => - Ind := Get_Resolution_Indication (Subtype_Def); - if Ind = Null_Iir then - -- No resolution indication. - return; - end if; - end case; - - declare - Type_Mark : constant Iir := Get_Denoted_Type_Mark (Subtype_Def); - begin - if Get_Kind (Type_Mark) in Iir_Kinds_Subtype_Definition - and then Get_Resolution_Indication (Type_Mark) = Ind - then - -- Resolution indication was inherited from the type_mark. - return; - end if; - end; - - Inner (Ind); - Put (" "); - end Disp_Resolution_Indication; - - procedure Disp_Integer_Subtype_Definition - (Def: Iir_Integer_Subtype_Definition) - is - Base_Type: Iir_Integer_Type_Definition; - Decl: Iir; - begin - if Def /= Std_Package.Universal_Integer_Subtype_Definition then - Base_Type := Get_Base_Type (Def); - Decl := Get_Type_Declarator (Base_Type); - if Base_Type /= Std_Package.Universal_Integer_Subtype_Definition - and then Def /= Decl - then - Disp_Name_Of (Decl); - Put (" "); - end if; - end if; - Disp_Resolution_Indication (Def); - Put ("range "); - Disp_Expression (Get_Range_Constraint (Def)); - Put (";"); - end Disp_Integer_Subtype_Definition; - - procedure Disp_Floating_Subtype_Definition - (Def: Iir_Floating_Subtype_Definition) - is - Base_Type: Iir_Floating_Type_Definition; - Decl: Iir; - begin - if Def /= Std_Package.Universal_Real_Subtype_Definition then - Base_Type := Get_Base_Type (Def); - Decl := Get_Type_Declarator (Base_Type); - if Base_Type /= Std_Package.Universal_Real_Subtype_Definition - and then Def /= Decl - then - Disp_Name_Of (Decl); - Put (" "); - end if; - end if; - Disp_Resolution_Indication (Def); - Put ("range "); - Disp_Expression (Get_Range_Constraint (Def)); - Put (";"); - end Disp_Floating_Subtype_Definition; - - procedure Disp_Element_Constraint (Def : Iir; Type_Mark : Iir); - - procedure Disp_Array_Element_Constraint (Def : Iir; Type_Mark : Iir) - is - Def_El : constant Iir := Get_Element_Subtype (Def); - Tm_El : constant Iir := Get_Element_Subtype (Type_Mark); - Has_Index : constant Boolean := Get_Index_Constraint_Flag (Def); - Has_Own_Element_Subtype : constant Boolean := Def_El /= Tm_El; - Index : Iir; - begin - if not Has_Index and not Has_Own_Element_Subtype then - return; - end if; - - if Get_Constraint_State (Type_Mark) /= Fully_Constrained - and then Has_Index - then - Put (" ("); - for I in Natural loop - Index := Get_Nth_Element (Get_Index_Subtype_List (Def), I); - exit when Index = Null_Iir; - if I /= 0 then - Put (", "); - end if; - --Disp_Expression (Get_Range_Constraint (Index)); - Disp_Range (Index); - end loop; - Put (")"); - end if; - - if Has_Own_Element_Subtype - and then Get_Kind (Def_El) in Iir_Kinds_Composite_Type_Definition - then - Disp_Element_Constraint (Def_El, Tm_El); - end if; - end Disp_Array_Element_Constraint; - - procedure Disp_Record_Element_Constraint (Def : Iir) - is - El_List : constant Iir_List := Get_Elements_Declaration_List (Def); - El : Iir; - Has_El : Boolean := False; - begin - for I in Natural loop - El := Get_Nth_Element (El_List, I); - exit when El = Null_Iir; - if Get_Kind (El) = Iir_Kind_Record_Element_Constraint - and then Get_Parent (El) = Def - then - if Has_El then - Put (", "); - else - Put ("("); - Has_El := True; - end if; - Disp_Name_Of (El); - Disp_Element_Constraint (Get_Type (El), - Get_Base_Type (Get_Type (El))); - end if; - end loop; - if Has_El then - Put (")"); - end if; - end Disp_Record_Element_Constraint; - - procedure Disp_Element_Constraint (Def : Iir; Type_Mark : Iir) is - begin - case Get_Kind (Def) is - when Iir_Kind_Record_Subtype_Definition => - Disp_Record_Element_Constraint (Def); - when Iir_Kind_Array_Subtype_Definition => - Disp_Array_Element_Constraint (Def, Type_Mark); - when others => - Error_Kind ("disp_element_constraint", Def); - end case; - end Disp_Element_Constraint; - - procedure Disp_Tolerance_Opt (N : Iir) is - Tol : constant Iir := Get_Tolerance (N); - begin - if Tol /= Null_Iir then - Put ("tolerance "); - Disp_Expression (Tol); - end if; - end Disp_Tolerance_Opt; - - procedure Disp_Subtype_Indication (Def : Iir; Full_Decl : Boolean := False) - is - Type_Mark : Iir; - Base_Type : Iir; - Decl : Iir; - begin - if Get_Kind (Def) in Iir_Kinds_Denoting_Name then - Disp_Name (Def); - return; - end if; - - Decl := Get_Type_Declarator (Def); - if not Full_Decl and then Decl /= Null_Iir then - Disp_Name_Of (Decl); - return; - end if; - - -- Resolution function name. - Disp_Resolution_Indication (Def); - - -- type mark. - Type_Mark := Get_Subtype_Type_Mark (Def); - if Type_Mark /= Null_Iir then - Disp_Name (Type_Mark); - Type_Mark := Get_Type (Type_Mark); - end if; - - Base_Type := Get_Base_Type (Def); - case Get_Kind (Base_Type) is - when Iir_Kind_Integer_Type_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Floating_Type_Definition - | Iir_Kind_Physical_Type_Definition => - if Type_Mark = Null_Iir - or else Get_Range_Constraint (Def) - /= Get_Range_Constraint (Type_Mark) - then - if Type_Mark /= Null_Iir then - Put (" range "); - end if; - Disp_Expression (Get_Range_Constraint (Def)); - end if; - if Get_Kind (Base_Type) = Iir_Kind_Floating_Type_Definition then - Disp_Tolerance_Opt (Def); - end if; - when Iir_Kind_Access_Type_Definition => - declare - Des_Ind : constant Iir := - Get_Designated_Subtype_Indication (Def); - begin - if Des_Ind /= Null_Iir then - pragma Assert - (Get_Kind (Des_Ind) = Iir_Kind_Array_Subtype_Definition); - Disp_Array_Element_Constraint - (Des_Ind, Get_Designated_Type (Base_Type)); - end if; - end; - when Iir_Kind_Array_Type_Definition => - if Type_Mark = Null_Iir then - Disp_Array_Element_Constraint (Def, Def); - else - Disp_Array_Element_Constraint (Def, Type_Mark); - end if; - when Iir_Kind_Record_Type_Definition => - Disp_Record_Element_Constraint (Def); - when others => - Error_Kind ("disp_subtype_indication", Base_Type); - end case; - end Disp_Subtype_Indication; - - procedure Disp_Enumeration_Type_Definition - (Def: Iir_Enumeration_Type_Definition) - is - Len : Count; - Start_Col: Count; - Decl: Name_Id; - A_Lit: Iir; --Enumeration_Literal_Acc; - begin - for I in Natural loop - A_Lit := Get_Nth_Element (Get_Enumeration_Literal_List (Def), I); - exit when A_Lit = Null_Iir; - if I = Natural'first then - Put ("("); - Start_Col := Col; - else - Put (", "); - end if; - Decl := Get_Identifier (A_Lit); - if Name_Table.Is_Character (Decl) then - Len := 3; - else - Len := Count (Name_Table.Get_Name_Length (Decl)); - end if; - if Col + Len + 2 > Line_Length then - New_Line; - Set_Col (Start_Col); - end if; - Disp_Name_Of (A_Lit); - end loop; - Put (");"); - end Disp_Enumeration_Type_Definition; - - procedure Disp_Enumeration_Subtype_Definition - (Def: Iir_Enumeration_Subtype_Definition) - is - begin - Disp_Resolution_Indication (Def); - Put ("range "); - Disp_Range (Def); - Put (";"); - end Disp_Enumeration_Subtype_Definition; - - procedure Disp_Discrete_Range (Iterator: Iir) is - begin - if Get_Kind (Iterator) in Iir_Kinds_Subtype_Definition then - Disp_Subtype_Indication (Iterator); - else - Disp_Range (Iterator); - end if; - end Disp_Discrete_Range; - - procedure Disp_Array_Subtype_Definition (Def: Iir_Array_Subtype_Definition) - is - Index: Iir; - begin - Disp_Resolution_Indication (Def); - - Put ("array ("); - for I in Natural loop - Index := Get_Nth_Element (Get_Index_Subtype_List (Def), I); - exit when Index = Null_Iir; - if I /= 0 then - Put (", "); - end if; - Disp_Discrete_Range (Index); - end loop; - Put (") of "); - Disp_Subtype_Indication (Get_Element_Subtype (Def)); - end Disp_Array_Subtype_Definition; - - procedure Disp_Array_Type_Definition (Def: Iir_Array_Type_Definition) is - Index: Iir; - begin - Put ("array ("); - for I in Natural loop - Index := Get_Nth_Element (Get_Index_Subtype_List (Def), I); - exit when Index = Null_Iir; - if I /= 0 then - Put (", "); - end if; - Disp_Name (Index); - Put (" range <>"); - end loop; - Put (") of "); - Disp_Subtype_Indication (Get_Element_Subtype_Indication (Def)); - Put (";"); - end Disp_Array_Type_Definition; - - procedure Disp_Physical_Literal (Lit: Iir) is - begin - case Get_Kind (Lit) is - when Iir_Kind_Physical_Int_Literal => - Disp_Int64 (Get_Value (Lit)); - when Iir_Kind_Physical_Fp_Literal => - Disp_Fp64 (Get_Fp_Value (Lit)); - when Iir_Kind_Unit_Declaration => - Disp_Identifier (Lit); - return; - when others => - Error_Kind ("disp_physical_literal", Lit); - end case; - Put (' '); - Disp_Name (Get_Unit_Name (Lit)); - end Disp_Physical_Literal; - - procedure Disp_Physical_Subtype_Definition - (Def: Iir_Physical_Subtype_Definition) is - begin - Disp_Resolution_Indication (Def); - Put ("range "); - Disp_Expression (Get_Range_Constraint (Def)); - end Disp_Physical_Subtype_Definition; - - procedure Disp_Record_Type_Definition - (Def: Iir_Record_Type_Definition; Indent: Count) - is - List : Iir_List; - El: Iir_Element_Declaration; - Reindent : Boolean; - begin - Put_Line ("record"); - Set_Col (Indent); - List := Get_Elements_Declaration_List (Def); - Reindent := True; - for I in Natural loop - El := Get_Nth_Element (List, I); - exit when El = Null_Iir; - if Reindent then - Set_Col (Indent + Indentation); - end if; - Disp_Identifier (El); - if Get_Has_Identifier_List (El) then - Put (", "); - Reindent := False; - else - Put (" : "); - Disp_Subtype_Indication (Get_Type (El)); - Put_Line (";"); - Reindent := True; - end if; - end loop; - Set_Col (Indent); - Disp_End (Def, "record"); - end Disp_Record_Type_Definition; - - procedure Disp_Designator_List (List: Iir_List) is - El: Iir; - begin - if List = Null_Iir_List then - return; - elsif List = Iir_List_All then - Put ("all"); - return; - end if; - for I in Natural loop - El := Get_Nth_Element (List, I); - exit when El = Null_Iir; - if I > 0 then - Put (", "); - end if; - Disp_Expression (El); - --Disp_Text_Literal (El); - end loop; - end Disp_Designator_List; - - -- Display the full definition of a type, ie the sequence that can create - -- such a type. - procedure Disp_Type_Definition (Def: Iir; Indent: Count) is - begin - case Get_Kind (Def) is - when Iir_Kind_Enumeration_Type_Definition => - Disp_Enumeration_Type_Definition (Def); - when Iir_Kind_Enumeration_Subtype_Definition => - Disp_Enumeration_Subtype_Definition (Def); - when Iir_Kind_Integer_Subtype_Definition => - Disp_Integer_Subtype_Definition (Def); - when Iir_Kind_Floating_Subtype_Definition => - Disp_Floating_Subtype_Definition (Def); - when Iir_Kind_Array_Type_Definition => - Disp_Array_Type_Definition (Def); - when Iir_Kind_Array_Subtype_Definition => - Disp_Array_Subtype_Definition (Def); - when Iir_Kind_Physical_Subtype_Definition => - Disp_Physical_Subtype_Definition (Def); - when Iir_Kind_Record_Type_Definition => - Disp_Record_Type_Definition (Def, Indent); - when Iir_Kind_Access_Type_Definition => - Put ("access "); - Disp_Subtype_Indication (Get_Designated_Subtype_Indication (Def)); - Put (';'); - when Iir_Kind_File_Type_Definition => - Put ("file of "); - Disp_Subtype_Indication (Get_File_Type_Mark (Def)); - Put (';'); - when Iir_Kind_Protected_Type_Declaration => - Put_Line ("protected"); - Disp_Declaration_Chain (Def, Indent + Indentation); - Set_Col (Indent); - Disp_End (Def, "protected"); - when Iir_Kind_Integer_Type_Definition => - Put (""); - when Iir_Kind_Floating_Type_Definition => - Put (""); - when Iir_Kind_Physical_Type_Definition => - Put (""); - when others => - Error_Kind ("disp_type_definition", Def); - end case; - end Disp_Type_Definition; - - procedure Disp_Type_Declaration (Decl: Iir_Type_Declaration) - is - Indent: Count; - Def : Iir; - begin - Indent := Col; - Put ("type "); - Disp_Name_Of (Decl); - Def := Get_Type_Definition (Decl); - if Def = Null_Iir - or else Get_Kind (Def) = Iir_Kind_Incomplete_Type_Definition - then - Put_Line (";"); - else - Put (" is "); - Disp_Type_Definition (Def, Indent); - New_Line; - end if; - end Disp_Type_Declaration; - - procedure Disp_Anonymous_Type_Declaration - (Decl: Iir_Anonymous_Type_Declaration) - is - Def : constant Iir := Get_Type_Definition (Decl); - Indent: constant Count := Col; - begin - Put ("type "); - Disp_Identifier (Decl); - Put (" is "); - case Get_Kind (Def) is - when Iir_Kind_Array_Type_Definition => - declare - St : constant Iir := Get_Subtype_Definition (Decl); - Indexes : constant Iir_List := Get_Index_Subtype_List (St); - Index : Iir; - begin - Put ("array ("); - for I in Natural loop - Index := Get_Nth_Element (Indexes, I); - exit when Index = Null_Iir; - if I /= 0 then - Put (", "); - end if; - Disp_Discrete_Range (Index); - end loop; - Put (") of "); - Disp_Subtype_Indication (Get_Element_Subtype_Indication (Def)); - Put (";"); - end; - when Iir_Kind_Physical_Type_Definition => - declare - St : constant Iir := Get_Subtype_Definition (Decl); - Unit : Iir_Unit_Declaration; - begin - Put ("range "); - Disp_Expression (Get_Range_Constraint (St)); - Put_Line (" units"); - Set_Col (Indent + Indentation); - Unit := Get_Unit_Chain (Def); - Disp_Identifier (Unit); - Put_Line (";"); - Unit := Get_Chain (Unit); - while Unit /= Null_Iir loop - Set_Col (Indent + Indentation); - Disp_Identifier (Unit); - Put (" = "); - Disp_Expression (Get_Physical_Literal (Unit)); - Put_Line (";"); - Unit := Get_Chain (Unit); - end loop; - Set_Col (Indent); - Disp_End (Def, "units"); - end; - when Iir_Kind_Floating_Type_Definition - | Iir_Kind_Integer_Type_Definition => - declare - St : constant Iir := Get_Subtype_Definition (Decl); - begin - Put ("range "); - Disp_Expression (Get_Range_Constraint (St)); - Put (";"); - end; - when others => - Disp_Type_Definition (Def, Indent); - end case; - New_Line; - end Disp_Anonymous_Type_Declaration; - - procedure Disp_Subtype_Declaration (Decl: in Iir_Subtype_Declaration) - is - Def : constant Iir := Get_Type (Decl); - Bt_Decl : constant Iir := Get_Type_Declarator (Get_Base_Type (Def)); - begin - if Get_Identifier (Decl) = Get_Identifier (Bt_Decl) then - Put ("-- "); - end if; - Put ("subtype "); - Disp_Name_Of (Decl); - Put (" is "); - Disp_Subtype_Indication (Def, True); - Put_Line (";"); - end Disp_Subtype_Declaration; - - procedure Disp_Type (A_Type: Iir) - is - Decl: Iir; - begin - Decl := Get_Type_Declarator (A_Type); - if Decl /= Null_Iir then - Disp_Name_Of (Decl); - else - case Get_Kind (A_Type) is - when Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Integer_Type_Definition => - raise Program_Error; - when Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Access_Subtype_Definition => - Disp_Subtype_Indication (A_Type); - when Iir_Kind_Array_Subtype_Definition => - Disp_Subtype_Indication (A_Type); - when others => - Error_Kind ("disp_type", A_Type); - end case; - end if; - end Disp_Type; - - procedure Disp_Nature_Definition (Def : Iir) is - begin - case Get_Kind (Def) is - when Iir_Kind_Scalar_Nature_Definition => - Disp_Subtype_Indication (Get_Across_Type (Def)); - Put (" across "); - Disp_Subtype_Indication (Get_Through_Type (Def)); - Put (" through "); - Disp_Name_Of (Get_Reference (Def)); - Put (" reference"); - when others => - Error_Kind ("disp_nature_definition", Def); - end case; - end Disp_Nature_Definition; - - procedure Disp_Nature_Declaration (Decl : Iir) is - begin - Put ("nature "); - Disp_Name_Of (Decl); - Put (" is "); - Disp_Nature_Definition (Get_Nature (Decl)); - Put_Line (";"); - end Disp_Nature_Declaration; - - procedure Disp_Nature (Nature : Iir) - is - Decl: Iir; - begin - Decl := Get_Nature_Declarator (Nature); - if Decl /= Null_Iir then - Disp_Name_Of (Decl); - else - Error_Kind ("disp_nature", Nature); - end if; - end Disp_Nature; - - procedure Disp_Mode (Mode: Iir_Mode) is - begin - case Mode is - when Iir_In_Mode => - Put ("in "); - when Iir_Out_Mode => - Put ("out "); - when Iir_Inout_Mode => - Put ("inout "); - when Iir_Buffer_Mode => - Put ("buffer "); - when Iir_Linkage_Mode => - Put ("linkage "); - when Iir_Unknown_Mode => - Put (" "); - end case; - end Disp_Mode; - - procedure Disp_Signal_Kind (Kind: Iir_Signal_Kind) is - begin - case Kind is - when Iir_No_Signal_Kind => - null; - when Iir_Register_Kind => - Put (" register"); - when Iir_Bus_Kind => - Put (" bus"); - end case; - end Disp_Signal_Kind; - - procedure Disp_Interface_Class (Inter: Iir) is - begin - if (Get_Lexical_Layout (Inter) and Iir_Lexical_Has_Class) /= 0 then - case Get_Kind (Inter) is - when Iir_Kind_Interface_Signal_Declaration => - Put ("signal "); - when Iir_Kind_Interface_Variable_Declaration => - Put ("variable "); - when Iir_Kind_Interface_Constant_Declaration => - Put ("constant "); - when Iir_Kind_Interface_File_Declaration => - Put ("file "); - when others => - Error_Kind ("disp_interface_class", Inter); - end case; - end if; - end Disp_Interface_Class; - - procedure Disp_Interface_Mode_And_Type (Inter: Iir) - is - Default: constant Iir := Get_Default_Value (Inter); - Ind : constant Iir := Get_Subtype_Indication (Inter); - begin - Put (": "); - if (Get_Lexical_Layout (Inter) and Iir_Lexical_Has_Mode) /= 0 then - Disp_Mode (Get_Mode (Inter)); - end if; - if Ind = Null_Iir then - -- For implicit subprogram - Disp_Type (Get_Type (Inter)); - else - Disp_Subtype_Indication (Get_Subtype_Indication (Inter)); - end if; - if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then - Disp_Signal_Kind (Get_Signal_Kind (Inter)); - end if; - if Default /= Null_Iir then - Put (" := "); - Disp_Expression (Default); - end if; - end Disp_Interface_Mode_And_Type; - - -- Disp interfaces, followed by END_STR (';' in general). - procedure Disp_Interface_Chain (Chain: Iir; - End_Str: String := ""; - Comment_Col : Natural := 0) - is - Inter: Iir; - Next_Inter : Iir; - Start: Count; - begin - if Chain = Null_Iir then - return; - end if; - Put (" ("); - Start := Col; - Inter := Chain; - loop - Next_Inter := Get_Chain (Inter); - Set_Col (Start); - - case Get_Kind (Inter) is - when Iir_Kinds_Interface_Object_Declaration => - Disp_Interface_Class (Inter); - Disp_Name_Of (Inter); - while (Get_Lexical_Layout (Inter) and Iir_Lexical_Has_Type) = 0 - loop - Put (", "); - Inter := Next_Inter; - Next_Inter := Get_Chain (Inter); - Disp_Name_Of (Inter); - end loop; - Disp_Interface_Mode_And_Type (Inter); - when Iir_Kind_Interface_Package_Declaration => - Put ("package "); - Disp_Identifier (Inter); - Put (" is new "); - Disp_Name (Get_Uninstantiated_Package_Name (Inter)); - Put (" generic map "); - declare - Assoc_Chain : constant Iir := - Get_Generic_Map_Aspect_Chain (Inter); - begin - if Assoc_Chain = Null_Iir then - Put ("(<>)"); - else - Disp_Association_Chain (Assoc_Chain); - end if; - end; - when others => - Error_Kind ("disp_interface_chain", Inter); - end case; - - if Next_Inter /= Null_Iir then - Put (";"); - if Comment_Col /= 0 then - New_Line; - Set_Col (Comment_Col); - Put ("--"); - end if; - else - Put (')'); - Put (End_Str); - exit; - end if; - - Inter := Next_Inter; - Next_Inter := Get_Chain (Inter); - end loop; - end Disp_Interface_Chain; - - procedure Disp_Ports (Parent : Iir) is - begin - Put ("port"); - Disp_Interface_Chain (Get_Port_Chain (Parent), ";"); - end Disp_Ports; - - procedure Disp_Generics (Parent : Iir) is - begin - Put ("generic"); - Disp_Interface_Chain (Get_Generic_Chain (Parent), ";"); - end Disp_Generics; - - procedure Disp_Entity_Declaration (Decl: Iir_Entity_Declaration) is - Start: constant Count := Col; - begin - Put ("entity "); - Disp_Name_Of (Decl); - Put_Line (" is"); - if Get_Generic_Chain (Decl) /= Null_Iir then - Set_Col (Start + Indentation); - Disp_Generics (Decl); - end if; - if Get_Port_Chain (Decl) /= Null_Iir then - Set_Col (Start + Indentation); - Disp_Ports (Decl); - end if; - Disp_Declaration_Chain (Decl, Start + Indentation); - if Get_Has_Begin (Decl) then - Set_Col (Start); - Put_Line ("begin"); - end if; - if Get_Concurrent_Statement_Chain (Decl) /= Null_Iir then - Disp_Concurrent_Statement_Chain (Decl, Start + Indentation); - end if; - Set_Col (Start); - Disp_End (Decl, "entity"); - end Disp_Entity_Declaration; - - procedure Disp_Component_Declaration (Decl: Iir_Component_Declaration) - is - Indent: Count; - begin - Indent := Col; - Put ("component "); - Disp_Name_Of (Decl); - if Get_Has_Is (Decl) then - Put (" is"); - end if; - if Get_Generic_Chain (Decl) /= Null_Iir then - Set_Col (Indent + Indentation); - Disp_Generics (Decl); - end if; - if Get_Port_Chain (Decl) /= Null_Iir then - Set_Col (Indent + Indentation); - Disp_Ports (Decl); - end if; - Set_Col (Indent); - Disp_End (Decl, "component"); - end Disp_Component_Declaration; - - procedure Disp_Concurrent_Statement_Chain (Parent : Iir; Indent : Count) - is - El: Iir; - begin - El := Get_Concurrent_Statement_Chain (Parent); - while El /= Null_Iir loop - Set_Col (Indent); - Disp_Concurrent_Statement (El); - El := Get_Chain (El); - end loop; - end Disp_Concurrent_Statement_Chain; - - procedure Disp_Architecture_Body (Arch: Iir_Architecture_Body) - is - Start: Count; - begin - Start := Col; - Put ("architecture "); - Disp_Name_Of (Arch); - Put (" of "); - Disp_Name (Get_Entity_Name (Arch)); - Put_Line (" is"); - Disp_Declaration_Chain (Arch, Start + Indentation); - Set_Col (Start); - Put_Line ("begin"); - Disp_Concurrent_Statement_Chain (Arch, Start + Indentation); - Set_Col (Start); - Disp_End (Arch, "architecture"); - end Disp_Architecture_Body; - - procedure Disp_Signature (Sig : Iir) - is - List : Iir_List; - El : Iir; - begin - Disp_Name (Get_Signature_Prefix (Sig)); - Put (" ["); - List := Get_Type_Marks_List (Sig); - if List /= Null_Iir_List then - for I in Natural loop - El := Get_Nth_Element (List, I); - exit when El = Null_Iir; - if I /= 0 then - Put (", "); - end if; - Disp_Name (El); - end loop; - end if; - El := Get_Return_Type_Mark (Sig); - if El /= Null_Iir then - Put (" return "); - Disp_Name (El); - end if; - Put ("]"); - end Disp_Signature; - - procedure Disp_Object_Alias_Declaration (Decl: Iir_Object_Alias_Declaration) - is - begin - Put ("alias "); - Disp_Name_Of (Decl); - Put (": "); - Disp_Type (Get_Type (Decl)); - Put (" is "); - Disp_Expression (Get_Name (Decl)); - Put_Line (";"); - end Disp_Object_Alias_Declaration; - - procedure Disp_Non_Object_Alias_Declaration - (Decl: Iir_Non_Object_Alias_Declaration) - is - Sig : constant Iir := Get_Alias_Signature (Decl); - begin - if Get_Implicit_Alias_Flag (Decl) then - Put ("-- "); - end if; - - Put ("alias "); - Disp_Function_Name (Decl); - Put (" is "); - if Sig /= Null_Iir then - Disp_Signature (Sig); - else - Disp_Name (Get_Name (Decl)); - end if; - Put_Line (";"); - end Disp_Non_Object_Alias_Declaration; - - procedure Disp_File_Declaration (Decl: Iir_File_Declaration) - is - Next_Decl : Iir; - Expr: Iir; - begin - Put ("file "); - Disp_Name_Of (Decl); - Next_Decl := Decl; - while Get_Has_Identifier_List (Next_Decl) loop - Next_Decl := Get_Chain (Next_Decl); - Put (", "); - Disp_Name_Of (Next_Decl); - end loop; - Put (": "); - Disp_Type (Get_Type (Decl)); - if Vhdl_Std = Vhdl_87 then - Put (" is "); - if Get_Has_Mode (Decl) then - Disp_Mode (Get_Mode (Decl)); - end if; - Disp_Expression (Get_File_Logical_Name (Decl)); - else - Expr := Get_File_Open_Kind (Decl); - if Expr /= Null_Iir then - Put (" open "); - Disp_Expression (Expr); - end if; - Expr := Get_File_Logical_Name (Decl); - if Expr /= Null_Iir then - Put (" is "); - Disp_Expression (Expr); - end if; - end if; - Put (';'); - end Disp_File_Declaration; - - procedure Disp_Quantity_Declaration (Decl: Iir) - is - Expr : Iir; - Term : Iir; - begin - Put ("quantity "); - Disp_Name_Of (Decl); - - case Get_Kind (Decl) is - when Iir_Kinds_Branch_Quantity_Declaration => - Disp_Tolerance_Opt (Decl); - Expr := Get_Default_Value (Decl); - if Expr /= Null_Iir then - Put (":= "); - Disp_Expression (Expr); - end if; - if Get_Kind (Decl) = Iir_Kind_Across_Quantity_Declaration then - Put (" across "); - else - Put (" through "); - end if; - Disp_Name_Of (Get_Plus_Terminal (Decl)); - Term := Get_Minus_Terminal (Decl); - if Term /= Null_Iir then - Put (" to "); - Disp_Name_Of (Term); - end if; - when Iir_Kind_Free_Quantity_Declaration => - Put (": "); - Disp_Type (Get_Type (Decl)); - Expr := Get_Default_Value (Decl); - if Expr /= Null_Iir then - Put (":= "); - Disp_Expression (Expr); - end if; - when others => - raise Program_Error; - end case; - Put (';'); - end Disp_Quantity_Declaration; - - procedure Disp_Terminal_Declaration (Decl: Iir) is - begin - Put ("terminal "); - Disp_Name_Of (Decl); - Put (": "); - Disp_Nature (Get_Nature (Decl)); - Put (';'); - end Disp_Terminal_Declaration; - - procedure Disp_Object_Declaration (Decl: Iir) - is - Next_Decl : Iir; - begin - case Get_Kind (Decl) is - when Iir_Kind_Variable_Declaration => - if Get_Shared_Flag (Decl) then - Put ("shared "); - end if; - Put ("variable "); - when Iir_Kind_Constant_Declaration => - Put ("constant "); - when Iir_Kind_Signal_Declaration => - Put ("signal "); - when Iir_Kind_File_Declaration => - Disp_File_Declaration (Decl); - return; - when others => - raise Internal_Error; - end case; - Disp_Name_Of (Decl); - Next_Decl := Decl; - while Get_Has_Identifier_List (Next_Decl) loop - Next_Decl := Get_Chain (Next_Decl); - Put (", "); - Disp_Name_Of (Next_Decl); - end loop; - Put (": "); - Disp_Subtype_Indication (Get_Subtype_Indication (Decl)); - if Get_Kind (Decl) = Iir_Kind_Signal_Declaration then - Disp_Signal_Kind (Get_Signal_Kind (Decl)); - end if; - - if Get_Default_Value (Decl) /= Null_Iir then - Put (" := "); - Disp_Expression (Get_Default_Value (Decl)); - end if; - Put_Line (";"); - end Disp_Object_Declaration; - - procedure Disp_Pure (Subprg : Iir) is - begin - if Get_Pure_Flag (Subprg) then - Put ("pure"); - else - Put ("impure"); - end if; - end Disp_Pure; - - procedure Disp_Subprogram_Declaration (Subprg: Iir) - is - Start : constant Count := Col; - Implicit : constant Boolean := - Get_Kind (Subprg) in Iir_Kinds_Implicit_Subprogram_Declaration; - Inter : Iir; - begin - if Implicit - and then - Get_Implicit_Definition (Subprg) /= Iir_Predefined_Now_Function - then - Put ("-- "); - end if; - - case Get_Kind (Subprg) is - when Iir_Kind_Function_Declaration => - if Get_Has_Pure (Subprg) then - Disp_Pure (Subprg); - Put (' '); - end if; - Put ("function"); - when Iir_Kind_Implicit_Function_Declaration => - Put ("function"); - when Iir_Kind_Procedure_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - Put ("procedure"); - when others => - raise Internal_Error; - end case; - - Put (' '); - Disp_Function_Name (Subprg); - - Inter := Get_Interface_Declaration_Chain (Subprg); - if Implicit then - Disp_Interface_Chain (Inter, "", Start); - else - Disp_Interface_Chain (Inter, "", 0); - end if; - - case Get_Kind (Subprg) is - when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration => - Put (" return "); - if Implicit then - Disp_Type (Get_Return_Type (Subprg)); - else - Disp_Name (Get_Return_Type_Mark (Subprg)); - end if; - when Iir_Kind_Procedure_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - null; - when others => - raise Internal_Error; - end case; - end Disp_Subprogram_Declaration; - - procedure Disp_Subprogram_Body (Subprg : Iir) - is - Indent : constant Count := Col; - begin - Disp_Declaration_Chain (Subprg, Indent + Indentation); - Set_Col (Indent); - Put_Line ("begin"); - Set_Col (Indent + Indentation); - Disp_Sequential_Statements (Get_Sequential_Statement_Chain (Subprg)); - Set_Col (Indent); - if Get_Kind (Subprg) = Iir_Kind_Function_Body then - Disp_End (Subprg, "function"); - else - Disp_End (Subprg, "procedure"); - end if; - end Disp_Subprogram_Body; - - procedure Disp_Instantiation_List (Insts: Iir_List) is - El : Iir; - begin - if Insts = Iir_List_All then - Put ("all"); - elsif Insts = Iir_List_Others then - Put ("others"); - else - for I in Natural loop - El := Get_Nth_Element (Insts, I); - exit when El = Null_Iir; - if I /= Natural'First then - Put (", "); - end if; - Disp_Name_Of (El); - end loop; - end if; - end Disp_Instantiation_List; - - procedure Disp_Configuration_Specification - (Spec : Iir_Configuration_Specification) - is - Indent : Count; - begin - Indent := Col; - Put ("for "); - Disp_Instantiation_List (Get_Instantiation_List (Spec)); - Put (": "); - Disp_Name (Get_Component_Name (Spec)); - New_Line; - Disp_Binding_Indication (Get_Binding_Indication (Spec), - Indent + Indentation); - Put_Line (";"); - end Disp_Configuration_Specification; - - procedure Disp_Disconnection_Specification - (Dis : Iir_Disconnection_Specification) - is - begin - Put ("disconnect "); - Disp_Instantiation_List (Get_Signal_List (Dis)); - Put (": "); - Disp_Name (Get_Type_Mark (Dis)); - Put (" after "); - Disp_Expression (Get_Expression (Dis)); - Put_Line (";"); - end Disp_Disconnection_Specification; - - procedure Disp_Attribute_Declaration (Attr : Iir_Attribute_Declaration) - is - begin - Put ("attribute "); - Disp_Identifier (Attr); - Put (": "); - Disp_Name (Get_Type_Mark (Attr)); - Put_Line (";"); - end Disp_Attribute_Declaration; - - procedure Disp_Attribute_Value (Attr : Iir) is - begin - Disp_Name_Of (Get_Designated_Entity (Attr)); - Put ("'"); - Disp_Identifier - (Get_Attribute_Designator (Get_Attribute_Specification (Attr))); - end Disp_Attribute_Value; - - procedure Disp_Attribute_Name (Attr : Iir) - is - Sig : constant Iir := Get_Attribute_Signature (Attr); - begin - if Sig /= Null_Iir then - Disp_Signature (Sig); - else - Disp_Name (Get_Prefix (Attr)); - end if; - Put ("'"); - Disp_Ident (Get_Identifier (Attr)); - end Disp_Attribute_Name; - - procedure Disp_Entity_Kind (Tok : Tokens.Token_Type) is - begin - Put (Tokens.Image (Tok)); - end Disp_Entity_Kind; - - procedure Disp_Entity_Name_List (List : Iir_List) - is - El : Iir; - begin - if List = Iir_List_All then - Put ("all"); - elsif List = Iir_List_Others then - Put ("others"); - else - for I in Natural loop - El := Get_Nth_Element (List, I); - exit when El = Null_Iir; - if I /= 0 then - Put (", "); - end if; - if Get_Kind (El) = Iir_Kind_Signature then - Disp_Signature (El); - else - Disp_Name (El); - end if; - end loop; - end if; - end Disp_Entity_Name_List; - - procedure Disp_Attribute_Specification (Attr : Iir_Attribute_Specification) - is - begin - Put ("attribute "); - Disp_Identifier (Get_Attribute_Designator (Attr)); - Put (" of "); - Disp_Entity_Name_List (Get_Entity_Name_List (Attr)); - Put (": "); - Disp_Entity_Kind (Get_Entity_Class (Attr)); - Put (" is "); - Disp_Expression (Get_Expression (Attr)); - Put_Line (";"); - end Disp_Attribute_Specification; - - procedure Disp_Protected_Type_Body - (Bod : Iir_Protected_Type_Body; Indent : Count) - is - begin - Put ("type "); - Disp_Identifier (Bod); - Put (" is protected body"); - New_Line; - Disp_Declaration_Chain (Bod, Indent + Indentation); - Set_Col (Indent); - Disp_End (Bod, "protected body"); - end Disp_Protected_Type_Body; - - procedure Disp_Group_Template_Declaration (Decl : Iir) - is - use Tokens; - Ent : Iir; - begin - Put ("group "); - Disp_Identifier (Decl); - Put (" is ("); - Ent := Get_Entity_Class_Entry_Chain (Decl); - loop - Disp_Entity_Kind (Get_Entity_Class (Ent)); - Ent := Get_Chain (Ent); - exit when Ent = Null_Iir; - if Get_Entity_Class (Ent) = Tok_Box then - Put (" <>"); - exit; - else - Put (", "); - end if; - end loop; - Put_Line (");"); - end Disp_Group_Template_Declaration; - - procedure Disp_Group_Declaration (Decl : Iir) - is - List : Iir_List; - El : Iir; - begin - Put ("group "); - Disp_Identifier (Decl); - Put (" : "); - Disp_Name (Get_Group_Template_Name (Decl)); - Put (" ("); - List := Get_Group_Constituent_List (Decl); - for I in Natural loop - El := Get_Nth_Element (List, I); - exit when El = Null_Iir; - if I /= 0 then - Put (", "); - end if; - Disp_Name_Of (El); - end loop; - Put_Line (");"); - end Disp_Group_Declaration; - - procedure Disp_Declaration_Chain (Parent : Iir; Indent: Count) - is - Decl: Iir; - begin - Decl := Get_Declaration_Chain (Parent); - while Decl /= Null_Iir loop - Set_Col (Indent); - case Get_Kind (Decl) is - when Iir_Kind_Type_Declaration => - Disp_Type_Declaration (Decl); - when Iir_Kind_Anonymous_Type_Declaration => - Disp_Anonymous_Type_Declaration (Decl); - when Iir_Kind_Subtype_Declaration => - Disp_Subtype_Declaration (Decl); - when Iir_Kind_Use_Clause => - Disp_Use_Clause (Decl); - when Iir_Kind_Component_Declaration => - Disp_Component_Declaration (Decl); - when Iir_Kind_File_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Variable_Declaration => - Disp_Object_Declaration (Decl); - while Get_Has_Identifier_List (Decl) loop - Decl := Get_Chain (Decl); - end loop; - when Iir_Kind_Object_Alias_Declaration => - Disp_Object_Alias_Declaration (Decl); - when Iir_Kind_Terminal_Declaration => - Disp_Terminal_Declaration (Decl); - when Iir_Kinds_Quantity_Declaration => - Disp_Quantity_Declaration (Decl); - when Iir_Kind_Nature_Declaration => - Disp_Nature_Declaration (Decl); - when Iir_Kind_Non_Object_Alias_Declaration => - Disp_Non_Object_Alias_Declaration (Decl); - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - Disp_Subprogram_Declaration (Decl); - Put_Line (";"); - when Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => - Disp_Subprogram_Declaration (Decl); - if not Get_Has_Body (Decl) then - Put_Line (";"); - end if; - when Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body => - -- The declaration was just displayed. - Put_Line (" is"); - Set_Col (Indent); - Disp_Subprogram_Body (Decl); - when Iir_Kind_Protected_Type_Body => - Disp_Protected_Type_Body (Decl, Indent); - when Iir_Kind_Configuration_Specification => - Disp_Configuration_Specification (Decl); - when Iir_Kind_Disconnection_Specification => - Disp_Disconnection_Specification (Decl); - when Iir_Kind_Attribute_Declaration => - Disp_Attribute_Declaration (Decl); - when Iir_Kind_Attribute_Specification => - Disp_Attribute_Specification (Decl); - when Iir_Kinds_Signal_Attribute => - null; - when Iir_Kind_Group_Template_Declaration => - Disp_Group_Template_Declaration (Decl); - when Iir_Kind_Group_Declaration => - Disp_Group_Declaration (Decl); - when others => - Error_Kind ("disp_declaration_chain", Decl); - end case; - Decl := Get_Chain (Decl); - end loop; - end Disp_Declaration_Chain; - - procedure Disp_Waveform (Chain : Iir_Waveform_Element) - is - We: Iir_Waveform_Element; - Val : Iir; - begin - if Chain = Null_Iir then - Put ("null after {disconnection_time}"); - return; - end if; - We := Chain; - while We /= Null_Iir loop - if We /= Chain then - Put (", "); - end if; - Val := Get_We_Value (We); - Disp_Expression (Val); - if Get_Time (We) /= Null_Iir then - Put (" after "); - Disp_Expression (Get_Time (We)); - end if; - We := Get_Chain (We); - end loop; - end Disp_Waveform; - - procedure Disp_Delay_Mechanism (Stmt: Iir) is - Expr: Iir; - begin - case Get_Delay_Mechanism (Stmt) is - when Iir_Transport_Delay => - Put ("transport "); - when Iir_Inertial_Delay => - Expr := Get_Reject_Time_Expression (Stmt); - if Expr /= Null_Iir then - Put ("reject "); - Disp_Expression (Expr); - Put (" inertial "); - end if; - end case; - end Disp_Delay_Mechanism; - - procedure Disp_Signal_Assignment (Stmt: Iir) is - begin - Disp_Expression (Get_Target (Stmt)); - Put (" <= "); - Disp_Delay_Mechanism (Stmt); - Disp_Waveform (Get_Waveform_Chain (Stmt)); - Put_Line (";"); - end Disp_Signal_Assignment; - - procedure Disp_Variable_Assignment (Stmt: Iir) is - begin - Disp_Expression (Get_Target (Stmt)); - Put (" := "); - Disp_Expression (Get_Expression (Stmt)); - Put_Line (";"); - end Disp_Variable_Assignment; - - procedure Disp_Label (Stmt : Iir) - is - Label: constant Name_Id := Get_Label (Stmt); - begin - if Label /= Null_Identifier then - Disp_Ident (Label); - Put (": "); - end if; - end Disp_Label; - - procedure Disp_Postponed (Stmt : Iir) is - begin - if Get_Postponed_Flag (Stmt) then - Put ("postponed "); - end if; - end Disp_Postponed; - - procedure Disp_Concurrent_Selected_Signal_Assignment (Stmt: Iir) - is - Indent: constant Count := Col; - Assoc: Iir; - Assoc_Chain : Iir; - begin - Set_Col (Indent); - Disp_Label (Stmt); - Disp_Postponed (Stmt); - Put ("with "); - Disp_Expression (Get_Expression (Stmt)); - Put (" select "); - Disp_Expression (Get_Target (Stmt)); - Put (" <= "); - if Get_Guard (Stmt) /= Null_Iir then - Put ("guarded "); - end if; - Disp_Delay_Mechanism (Stmt); - Assoc_Chain := Get_Selected_Waveform_Chain (Stmt); - Assoc := Assoc_Chain; - while Assoc /= Null_Iir loop - if Assoc /= Assoc_Chain then - Put_Line (","); - end if; - Set_Col (Indent + Indentation); - Disp_Waveform (Get_Associated_Chain (Assoc)); - Put (" when "); - Disp_Choice (Assoc); - end loop; - Put_Line (";"); - end Disp_Concurrent_Selected_Signal_Assignment; - - procedure Disp_Concurrent_Conditional_Signal_Assignment (Stmt: Iir) - is - Indent: Count; - Cond_Wf : Iir_Conditional_Waveform; - Expr : Iir; - begin - Disp_Label (Stmt); - Disp_Postponed (Stmt); - Disp_Expression (Get_Target (Stmt)); - Put (" <= "); - if Get_Guard (Stmt) /= Null_Iir then - Put ("guarded "); - end if; - Disp_Delay_Mechanism (Stmt); - Indent := Col; - Set_Col (Indent); - Cond_Wf := Get_Conditional_Waveform_Chain (Stmt); - while Cond_Wf /= Null_Iir loop - Disp_Waveform (Get_Waveform_Chain (Cond_Wf)); - Expr := Get_Condition (Cond_Wf); - if Expr /= Null_Iir then - Put (" when "); - Disp_Expression (Expr); - Put_Line (" else"); - Set_Col (Indent); - end if; - Cond_Wf := Get_Chain (Cond_Wf); - end loop; - - Put_Line (";"); - end Disp_Concurrent_Conditional_Signal_Assignment; - - procedure Disp_Assertion_Statement (Stmt: Iir) - is - Start: constant Count := Col; - Expr: Iir; - begin - if Get_Kind (Stmt) = Iir_Kind_Concurrent_Assertion_Statement then - Disp_Label (Stmt); - Disp_Postponed (Stmt); - end if; - Put ("assert "); - Disp_Expression (Get_Assertion_Condition (Stmt)); - Expr := Get_Report_Expression (Stmt); - if Expr /= Null_Iir then - Set_Col (Start + Indentation); - Put ("report "); - Disp_Expression (Expr); - end if; - Expr := Get_Severity_Expression (Stmt); - if Expr /= Null_Iir then - Set_Col (Start + Indentation); - Put ("severity "); - Disp_Expression (Expr); - end if; - Put_Line (";"); - end Disp_Assertion_Statement; - - procedure Disp_Report_Statement (Stmt: Iir) - is - Start: Count; - Expr: Iir; - begin - Start := Col; - Put ("report "); - Expr := Get_Report_Expression (Stmt); - Disp_Expression (Expr); - Expr := Get_Severity_Expression (Stmt); - if Expr /= Null_Iir then - Set_Col (Start + Indentation); - Put ("severity "); - Disp_Expression (Expr); - end if; - Put_Line (";"); - end Disp_Report_Statement; - - procedure Disp_Dyadic_Operator (Expr: Iir) is - begin - if Flag_Parenthesis then - Put ("("); - end if; - Disp_Expression (Get_Left (Expr)); - Put (' ' & Name_Table.Image (Iirs_Utils.Get_Operator_Name (Expr)) & ' '); - Disp_Expression (Get_Right (Expr)); - if Flag_Parenthesis then - Put (")"); - end if; - end Disp_Dyadic_Operator; - - procedure Disp_Monadic_Operator (Expr: Iir) is - begin - Put (Name_Table.Image (Iirs_Utils.Get_Operator_Name (Expr))); - Put (' '); - if Flag_Parenthesis then - Put ('('); - end if; - Disp_Expression (Get_Operand (Expr)); - if Flag_Parenthesis then - Put (')'); - end if; - end Disp_Monadic_Operator; - - procedure Disp_Case_Statement (Stmt: Iir_Case_Statement) - is - Indent: Count; - Assoc: Iir; - Sel_Stmt : Iir; - begin - Indent := Col; - Put ("case "); - Disp_Expression (Get_Expression (Stmt)); - Put_Line (" is"); - Assoc := Get_Case_Statement_Alternative_Chain (Stmt); - while Assoc /= Null_Iir loop - Set_Col (Indent + Indentation); - Put ("when "); - Sel_Stmt := Get_Associated_Chain (Assoc); - Disp_Choice (Assoc); - Put_Line (" =>"); - Set_Col (Indent + 2 * Indentation); - Disp_Sequential_Statements (Sel_Stmt); - end loop; - Set_Col (Indent); - Disp_End_Label (Stmt, "case"); - end Disp_Case_Statement; - - procedure Disp_Wait_Statement (Stmt: Iir_Wait_Statement) is - List: Iir_List; - Expr: Iir; - begin - Put ("wait"); - List := Get_Sensitivity_List (Stmt); - if List /= Null_Iir_List then - Put (" on "); - Disp_Designator_List (List); - end if; - Expr := Get_Condition_Clause (Stmt); - if Expr /= Null_Iir then - Put (" until "); - Disp_Expression (Expr); - end if; - Expr := Get_Timeout_Clause (Stmt); - if Expr /= Null_Iir then - Put (" for "); - Disp_Expression (Expr); - end if; - Put_Line (";"); - end Disp_Wait_Statement; - - procedure Disp_If_Statement (Stmt: Iir_If_Statement) is - Clause: Iir; - Expr: Iir; - Start: Count; - begin - Start := Col; - Put ("if "); - Clause := Stmt; - Disp_Expression (Get_Condition (Clause)); - Put_Line (" then"); - while Clause /= Null_Iir loop - Set_Col (Start + Indentation); - Disp_Sequential_Statements (Get_Sequential_Statement_Chain (Clause)); - Clause := Get_Else_Clause (Clause); - exit when Clause = Null_Iir; - Expr := Get_Condition (Clause); - Set_Col (Start); - if Expr /= Null_Iir then - Put ("elsif "); - Disp_Expression (Expr); - Put_Line (" then"); - else - Put_Line ("else"); - end if; - end loop; - Set_Col (Start); - Disp_End_Label (Stmt, "if"); - end Disp_If_Statement; - - procedure Disp_Parameter_Specification - (Iterator : Iir_Iterator_Declaration) is - begin - Disp_Identifier (Iterator); - Put (" in "); - Disp_Discrete_Range (Get_Discrete_Range (Iterator)); - end Disp_Parameter_Specification; - - procedure Disp_Method_Object (Call : Iir) - is - Obj : Iir; - begin - Obj := Get_Method_Object (Call); - if Obj /= Null_Iir then - Disp_Name (Obj); - Put ('.'); - end if; - end Disp_Method_Object; - - procedure Disp_Procedure_Call (Call : Iir) is - begin - if True then - Disp_Name (Get_Prefix (Call)); - else - Disp_Method_Object (Call); - Disp_Identifier (Get_Implementation (Call)); - Put (' '); - end if; - Disp_Association_Chain (Get_Parameter_Association_Chain (Call)); - Put_Line (";"); - end Disp_Procedure_Call; - - procedure Disp_Sequential_Statements (First : Iir) - is - Stmt: Iir; - Start: constant Count := Col; - begin - Stmt := First; - while Stmt /= Null_Iir loop - Set_Col (Start); - Disp_Label (Stmt); - case Get_Kind (Stmt) is - when Iir_Kind_Null_Statement => - Put_Line ("null;"); - when Iir_Kind_If_Statement => - Disp_If_Statement (Stmt); - when Iir_Kind_For_Loop_Statement => - Put ("for "); - Disp_Parameter_Specification - (Get_Parameter_Specification (Stmt)); - Put_Line (" loop"); - Set_Col (Start + Indentation); - Disp_Sequential_Statements - (Get_Sequential_Statement_Chain (Stmt)); - Set_Col (Start); - Disp_End_Label (Stmt, "loop"); - when Iir_Kind_While_Loop_Statement => - if Get_Condition (Stmt) /= Null_Iir then - Put ("while "); - Disp_Expression (Get_Condition (Stmt)); - Put (" "); - end if; - Put_Line ("loop"); - Set_Col (Start + Indentation); - Disp_Sequential_Statements - (Get_Sequential_Statement_Chain (Stmt)); - Set_Col (Start); - Disp_End_Label (Stmt, "loop"); - when Iir_Kind_Signal_Assignment_Statement => - Disp_Signal_Assignment (Stmt); - when Iir_Kind_Variable_Assignment_Statement => - Disp_Variable_Assignment (Stmt); - when Iir_Kind_Assertion_Statement => - Disp_Assertion_Statement (Stmt); - when Iir_Kind_Report_Statement => - Disp_Report_Statement (Stmt); - when Iir_Kind_Return_Statement => - if Get_Expression (Stmt) /= Null_Iir then - Put ("return "); - Disp_Expression (Get_Expression (Stmt)); - Put_Line (";"); - else - Put_Line ("return;"); - end if; - when Iir_Kind_Case_Statement => - Disp_Case_Statement (Stmt); - when Iir_Kind_Wait_Statement => - Disp_Wait_Statement (Stmt); - when Iir_Kind_Procedure_Call_Statement => - Disp_Procedure_Call (Get_Procedure_Call (Stmt)); - when Iir_Kind_Exit_Statement - | Iir_Kind_Next_Statement => - declare - Label : constant Iir := Get_Loop_Label (Stmt); - Cond : constant Iir := Get_Condition (Stmt); - begin - if Get_Kind (Stmt) = Iir_Kind_Exit_Statement then - Put ("exit"); - else - Put ("next"); - end if; - if Label /= Null_Iir then - Put (" "); - Disp_Name (Label); - end if; - if Cond /= Null_Iir then - Put (" when "); - Disp_Expression (Cond); - end if; - Put_Line (";"); - end; - - when others => - Error_Kind ("disp_sequential_statements", Stmt); - end case; - Stmt := Get_Chain (Stmt); - end loop; - end Disp_Sequential_Statements; - - procedure Disp_Process_Statement (Process: Iir) - is - Start: constant Count := Col; - begin - Disp_Label (Process); - Disp_Postponed (Process); - - Put ("process "); - if Get_Kind (Process) = Iir_Kind_Sensitized_Process_Statement then - Put ("("); - Disp_Designator_List (Get_Sensitivity_List (Process)); - Put (")"); - end if; - if Get_Has_Is (Process) then - Put (" is"); - end if; - New_Line; - Disp_Declaration_Chain (Process, Start + Indentation); - Set_Col (Start); - Put_Line ("begin"); - Set_Col (Start + Indentation); - Disp_Sequential_Statements (Get_Sequential_Statement_Chain (Process)); - Set_Col (Start); - Put ("end"); - if Get_End_Has_Postponed (Process) then - Put (" postponed"); - end if; - Disp_After_End (Process, "process"); - end Disp_Process_Statement; - - procedure Disp_Conversion (Conv : Iir) is - begin - case Get_Kind (Conv) is - when Iir_Kind_Function_Call => - Disp_Function_Name (Get_Implementation (Conv)); - when Iir_Kind_Type_Conversion => - Disp_Name_Of (Get_Type_Mark (Conv)); - when others => - Error_Kind ("disp_conversion", Conv); - end case; - end Disp_Conversion; - - procedure Disp_Association_Chain (Chain : Iir) - is - El: Iir; - Formal: Iir; - Need_Comma : Boolean; - Conv : Iir; - begin - if Chain = Null_Iir then - return; - end if; - Put ("("); - Need_Comma := False; - - El := Chain; - while El /= Null_Iir loop - if Get_Kind (El) /= Iir_Kind_Association_Element_By_Individual then - if Need_Comma then - Put (", "); - end if; - - -- Formal part. - if Get_Kind (El) = Iir_Kind_Association_Element_By_Expression then - Conv := Get_Out_Conversion (El); - if Conv /= Null_Iir then - Disp_Conversion (Conv); - Put (" ("); - end if; - else - Conv := Null_Iir; - end if; - Formal := Get_Formal (El); - if Formal /= Null_Iir then - Disp_Expression (Formal); - if Conv /= Null_Iir then - Put (")"); - end if; - Put (" => "); - end if; - - case Get_Kind (El) is - when Iir_Kind_Association_Element_Open => - Put ("open"); - when Iir_Kind_Association_Element_Package => - Disp_Name (Get_Actual (El)); - when others => - Conv := Get_In_Conversion (El); - if Conv /= Null_Iir then - Disp_Conversion (Conv); - Put (" ("); - end if; - Disp_Expression (Get_Actual (El)); - if Conv /= Null_Iir then - Put (")"); - end if; - end case; - Need_Comma := True; - end if; - El := Get_Chain (El); - end loop; - Put (")"); - end Disp_Association_Chain; - - procedure Disp_Generic_Map_Aspect (Parent : Iir) is - begin - Put ("generic map "); - Disp_Association_Chain (Get_Generic_Map_Aspect_Chain (Parent)); - end Disp_Generic_Map_Aspect; - - procedure Disp_Port_Map_Aspect (Parent : Iir) is - begin - Put ("port map "); - Disp_Association_Chain (Get_Port_Map_Aspect_Chain (Parent)); - end Disp_Port_Map_Aspect; - - procedure Disp_Entity_Aspect (Aspect : Iir) is - Arch : Iir; - begin - case Get_Kind (Aspect) is - when Iir_Kind_Entity_Aspect_Entity => - Put ("entity "); - Disp_Name (Get_Entity_Name (Aspect)); - Arch := Get_Architecture (Aspect); - if Arch /= Null_Iir then - Put (" ("); - Disp_Name_Of (Arch); - Put (")"); - end if; - when Iir_Kind_Entity_Aspect_Configuration => - Put ("configuration "); - Disp_Name (Get_Configuration_Name (Aspect)); - when Iir_Kind_Entity_Aspect_Open => - Put ("open"); - when others => - Error_Kind ("disp_entity_aspect", Aspect); - end case; - end Disp_Entity_Aspect; - - procedure Disp_Component_Instantiation_Statement - (Stmt: Iir_Component_Instantiation_Statement) - is - Component: constant Iir := Get_Instantiated_Unit (Stmt); - Alist: Iir; - begin - Disp_Label (Stmt); - if Get_Kind (Component) in Iir_Kinds_Denoting_Name then - Disp_Name (Component); - else - Disp_Entity_Aspect (Component); - end if; - Alist := Get_Generic_Map_Aspect_Chain (Stmt); - if Alist /= Null_Iir then - Put (" "); - Disp_Generic_Map_Aspect (Stmt); - end if; - Alist := Get_Port_Map_Aspect_Chain (Stmt); - if Alist /= Null_Iir then - Put (" "); - Disp_Port_Map_Aspect (Stmt); - end if; - Put (";"); - end Disp_Component_Instantiation_Statement; - - procedure Disp_Function_Call (Expr: Iir_Function_Call) is - begin - if True then - Disp_Name (Get_Prefix (Expr)); - else - Disp_Method_Object (Expr); - Disp_Function_Name (Get_Implementation (Expr)); - end if; - Disp_Association_Chain (Get_Parameter_Association_Chain (Expr)); - end Disp_Function_Call; - - procedure Disp_Indexed_Name (Indexed: Iir) - is - List : Iir_List; - El: Iir; - begin - Disp_Expression (Get_Prefix (Indexed)); - Put (" ("); - List := Get_Index_List (Indexed); - for I in Natural loop - El := Get_Nth_Element (List, I); - exit when El = Null_Iir; - if I /= 0 then - Put (", "); - end if; - Disp_Expression (El); - end loop; - Put (")"); - end Disp_Indexed_Name; - - procedure Disp_Choice (Choice: in out Iir) is - begin - loop - case Get_Kind (Choice) is - when Iir_Kind_Choice_By_Others => - Put ("others"); - when Iir_Kind_Choice_By_None => - null; - when Iir_Kind_Choice_By_Expression => - Disp_Expression (Get_Choice_Expression (Choice)); - when Iir_Kind_Choice_By_Range => - Disp_Range (Get_Choice_Range (Choice)); - when Iir_Kind_Choice_By_Name => - Disp_Name_Of (Get_Choice_Name (Choice)); - when others => - Error_Kind ("disp_choice", Choice); - end case; - Choice := Get_Chain (Choice); - exit when Choice = Null_Iir; - exit when Get_Same_Alternative_Flag (Choice) = False; - --exit when Choice = Null_Iir; - Put (" | "); - end loop; - end Disp_Choice; - - procedure Disp_Aggregate (Aggr: Iir_Aggregate) - is - Indent: Count; - Assoc: Iir; - Expr : Iir; - begin - Indent := Col; - if Indent > Line_Length - 10 then - Indent := 2 * Indentation; - end if; - Put ("("); - Assoc := Get_Association_Choices_Chain (Aggr); - loop - Expr := Get_Associated_Expr (Assoc); - if Get_Kind (Assoc) /= Iir_Kind_Choice_By_None then - Disp_Choice (Assoc); - Put (" => "); - else - Assoc := Get_Chain (Assoc); - end if; - if Get_Kind (Expr) = Iir_Kind_Aggregate - or else Get_Kind (Expr) = Iir_Kind_String_Literal then - Set_Col (Indent); - end if; - Disp_Expression (Expr); - exit when Assoc = Null_Iir; - Put (", "); - end loop; - Put (")"); - end Disp_Aggregate; - - procedure Disp_Simple_Aggregate (Aggr: Iir_Simple_Aggregate) - is - List : Iir_List; - El : Iir; - First : Boolean := True; - begin - Put ("("); - List := Get_Simple_Aggregate_List (Aggr); - for I in Natural loop - El := Get_Nth_Element (List, I); - exit when El = Null_Iir; - if First then - First := False; - else - Put (", "); - end if; - Disp_Expression (El); - end loop; - Put (")"); - end Disp_Simple_Aggregate; - - procedure Disp_Parametered_Attribute (Name : String; Expr : Iir) - is - Param : Iir; - Pfx : Iir; - begin - Pfx := Get_Prefix (Expr); - case Get_Kind (Pfx) is - when Iir_Kind_Type_Declaration - | Iir_Kind_Subtype_Declaration => - Disp_Name_Of (Pfx); - when others => - Disp_Expression (Pfx); - end case; - Put ("'"); - Put (Name); - Param := Get_Parameter (Expr); - if Param /= Null_Iir - and then Param /= Std_Package.Universal_Integer_One - then - Put (" ("); - Disp_Expression (Param); - Put (")"); - end if; - end Disp_Parametered_Attribute; - - procedure Disp_Parametered_Type_Attribute (Name : String; Expr : Iir) is - begin - Disp_Name (Get_Prefix (Expr)); - Put ("'"); - Put (Name); - Put (" ("); - Disp_Expression (Get_Parameter (Expr)); - Put (")"); - end Disp_Parametered_Type_Attribute; - - procedure Disp_String_Literal (Str : Iir) - is - Ptr : constant String_Fat_Acc := Get_String_Fat_Acc (Str); - Len : constant Int32 := Get_String_Length (Str); - begin - for I in 1 .. Len loop - if Ptr (I) = '"' then - Put ('"'); - end if; - Put (Ptr (I)); - end loop; - end Disp_String_Literal; - - procedure Disp_Expression (Expr: Iir) - is - Orig : Iir; - begin - case Get_Kind (Expr) is - when Iir_Kind_Integer_Literal => - Orig := Get_Literal_Origin (Expr); - if Orig /= Null_Iir then - Disp_Expression (Orig); - else - Disp_Int64 (Get_Value (Expr)); - end if; - when Iir_Kind_Floating_Point_Literal => - Orig := Get_Literal_Origin (Expr); - if Orig /= Null_Iir then - Disp_Expression (Orig); - else - Disp_Fp64 (Get_Fp_Value (Expr)); - end if; - when Iir_Kind_String_Literal => - Orig := Get_Literal_Origin (Expr); - if Orig /= Null_Iir then - Disp_Expression (Orig); - else - Put (""""); - Disp_String_Literal (Expr); - Put (""""); - if Disp_String_Literal_Type or Flags.List_Verbose then - Put ("[type: "); - Disp_Type (Get_Type (Expr)); - Put ("]"); - end if; - end if; - when Iir_Kind_Bit_String_Literal => - Orig := Get_Literal_Origin (Expr); - if Orig /= Null_Iir then - Disp_Expression (Orig); - else - if False then - case Get_Bit_String_Base (Expr) is - when Base_2 => - Put ('B'); - when Base_8 => - Put ('O'); - when Base_16 => - Put ('X'); - end case; - end if; - Put ("B"""); - Disp_String_Literal (Expr); - Put (""""); - end if; - when Iir_Kind_Physical_Fp_Literal - | Iir_Kind_Physical_Int_Literal => - Orig := Get_Literal_Origin (Expr); - if Orig /= Null_Iir then - Disp_Expression (Orig); - else - Disp_Physical_Literal (Expr); - end if; - when Iir_Kind_Unit_Declaration => - Disp_Name_Of (Expr); - when Iir_Kind_Character_Literal => - Disp_Identifier (Expr); - when Iir_Kind_Enumeration_Literal => - Orig := Get_Literal_Origin (Expr); - if Orig /= Null_Iir then - Disp_Expression (Orig); - else - Disp_Name_Of (Expr); - end if; - when Iir_Kind_Overflow_Literal => - Orig := Get_Literal_Origin (Expr); - if Orig /= Null_Iir then - Disp_Expression (Orig); - else - Put ("*OVERFLOW*"); - end if; - - when Iir_Kind_Object_Alias_Declaration => - Disp_Name_Of (Expr); - when Iir_Kind_Aggregate => - Disp_Aggregate (Expr); - when Iir_Kind_Null_Literal => - Put ("null"); - when Iir_Kind_Simple_Aggregate => - Orig := Get_Literal_Origin (Expr); - if Orig /= Null_Iir then - Disp_Expression (Orig); - else - Disp_Simple_Aggregate (Expr); - end if; - - when Iir_Kind_Attribute_Value => - Disp_Attribute_Value (Expr); - when Iir_Kind_Attribute_Name => - Disp_Attribute_Name (Expr); - - when Iir_Kind_Element_Declaration => - Disp_Name_Of (Expr); - - when Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Iterator_Declaration => - Disp_Name_Of (Expr); - return; - - when Iir_Kinds_Dyadic_Operator => - Disp_Dyadic_Operator (Expr); - when Iir_Kinds_Monadic_Operator => - Disp_Monadic_Operator (Expr); - when Iir_Kind_Function_Call => - Disp_Function_Call (Expr); - when Iir_Kind_Parenthesis_Expression => - Put ("("); - Disp_Expression (Get_Expression (Expr)); - Put (")"); - when Iir_Kind_Type_Conversion => - Disp_Name (Get_Type_Mark (Expr)); - Put (" ("); - Disp_Expression (Get_Expression (Expr)); - Put (")"); - when Iir_Kind_Qualified_Expression => - declare - Qexpr : constant Iir := Get_Expression (Expr); - Has_Paren : constant Boolean := - Get_Kind (Qexpr) = Iir_Kind_Parenthesis_Expression - or else Get_Kind (Qexpr) = Iir_Kind_Aggregate; - begin - Disp_Name (Get_Type_Mark (Expr)); - Put ("'"); - if not Has_Paren then - Put ("("); - end if; - Disp_Expression (Qexpr); - if not Has_Paren then - Put (")"); - end if; - end; - when Iir_Kind_Allocator_By_Expression => - Put ("new "); - Disp_Expression (Get_Expression (Expr)); - when Iir_Kind_Allocator_By_Subtype => - Put ("new "); - Disp_Subtype_Indication (Get_Subtype_Indication (Expr)); - - when Iir_Kind_Indexed_Name => - Disp_Indexed_Name (Expr); - when Iir_Kind_Slice_Name => - Disp_Expression (Get_Prefix (Expr)); - Put (" ("); - Disp_Range (Get_Suffix (Expr)); - Put (")"); - when Iir_Kind_Selected_Element => - Disp_Expression (Get_Prefix (Expr)); - Put ("."); - Disp_Name_Of (Get_Selected_Element (Expr)); - when Iir_Kind_Implicit_Dereference => - Disp_Expression (Get_Prefix (Expr)); - when Iir_Kind_Dereference => - Disp_Expression (Get_Prefix (Expr)); - Put (".all"); - - when Iir_Kind_Left_Type_Attribute => - Disp_Name (Get_Prefix (Expr)); - Put ("'left"); - when Iir_Kind_Right_Type_Attribute => - Disp_Name (Get_Prefix (Expr)); - Put ("'right"); - when Iir_Kind_High_Type_Attribute => - Disp_Name (Get_Prefix (Expr)); - Put ("'high"); - when Iir_Kind_Low_Type_Attribute => - Disp_Name (Get_Prefix (Expr)); - Put ("'low"); - when Iir_Kind_Ascending_Type_Attribute => - Disp_Name (Get_Prefix (Expr)); - Put ("'ascending"); - - when Iir_Kind_Stable_Attribute => - Disp_Parametered_Attribute ("stable", Expr); - when Iir_Kind_Quiet_Attribute => - Disp_Parametered_Attribute ("quiet", Expr); - when Iir_Kind_Delayed_Attribute => - Disp_Parametered_Attribute ("delayed", Expr); - when Iir_Kind_Transaction_Attribute => - Disp_Expression (Get_Prefix (Expr)); - Put ("'transaction"); - when Iir_Kind_Event_Attribute => - Disp_Expression (Get_Prefix (Expr)); - Put ("'event"); - when Iir_Kind_Active_Attribute => - Disp_Expression (Get_Prefix (Expr)); - Put ("'active"); - when Iir_Kind_Driving_Attribute => - Disp_Expression (Get_Prefix (Expr)); - Put ("'driving"); - when Iir_Kind_Driving_Value_Attribute => - Disp_Expression (Get_Prefix (Expr)); - Put ("'driving_value"); - when Iir_Kind_Last_Value_Attribute => - Disp_Expression (Get_Prefix (Expr)); - Put ("'last_value"); - when Iir_Kind_Last_Active_Attribute => - Disp_Expression (Get_Prefix (Expr)); - Put ("'last_active"); - when Iir_Kind_Last_Event_Attribute => - Disp_Expression (Get_Prefix (Expr)); - Put ("'last_event"); - - when Iir_Kind_Pos_Attribute => - Disp_Parametered_Type_Attribute ("pos", Expr); - when Iir_Kind_Val_Attribute => - Disp_Parametered_Type_Attribute ("val", Expr); - when Iir_Kind_Succ_Attribute => - Disp_Parametered_Type_Attribute ("succ", Expr); - when Iir_Kind_Pred_Attribute => - Disp_Parametered_Type_Attribute ("pred", Expr); - when Iir_Kind_Leftof_Attribute => - Disp_Parametered_Type_Attribute ("leftof", Expr); - when Iir_Kind_Rightof_Attribute => - Disp_Parametered_Type_Attribute ("rightof", Expr); - - when Iir_Kind_Length_Array_Attribute => - Disp_Parametered_Attribute ("length", Expr); - when Iir_Kind_Range_Array_Attribute => - Disp_Parametered_Attribute ("range", Expr); - when Iir_Kind_Reverse_Range_Array_Attribute => - Disp_Parametered_Attribute ("reverse_range", Expr); - when Iir_Kind_Left_Array_Attribute => - Disp_Parametered_Attribute ("left", Expr); - when Iir_Kind_Right_Array_Attribute => - Disp_Parametered_Attribute ("right", Expr); - when Iir_Kind_Low_Array_Attribute => - Disp_Parametered_Attribute ("low", Expr); - when Iir_Kind_High_Array_Attribute => - Disp_Parametered_Attribute ("high", Expr); - when Iir_Kind_Ascending_Array_Attribute => - Disp_Parametered_Attribute ("ascending", Expr); - - when Iir_Kind_Image_Attribute => - Disp_Parametered_Attribute ("image", Expr); - when Iir_Kind_Value_Attribute => - Disp_Parametered_Attribute ("value", Expr); - when Iir_Kind_Simple_Name_Attribute => - Disp_Name (Get_Prefix (Expr)); - Put ("'simple_name"); - when Iir_Kind_Instance_Name_Attribute => - Disp_Name (Get_Prefix (Expr)); - Put ("'instance_name"); - when Iir_Kind_Path_Name_Attribute => - Disp_Name (Get_Prefix (Expr)); - Put ("'path_name"); - - when Iir_Kind_Selected_By_All_Name => - Disp_Expression (Get_Prefix (Expr)); - when Iir_Kind_Selected_Name => - Disp_Name (Expr); - when Iir_Kind_Simple_Name => - Disp_Name (Expr); - - when Iir_Kinds_Type_And_Subtype_Definition => - Disp_Type (Expr); - - when Iir_Kind_Range_Expression => - Disp_Range (Expr); - when Iir_Kind_Subtype_Declaration => - Disp_Name_Of (Expr); - - when others => - Error_Kind ("disp_expression", Expr); - end case; - end Disp_Expression; - - procedure Disp_PSL_HDL_Expr (N : PSL.Nodes.HDL_Node) is - begin - Disp_Expression (Iir (N)); - end Disp_PSL_HDL_Expr; - - procedure Disp_Psl_Expression (Expr : PSL_Node) is - begin - PSL.Prints.HDL_Expr_Printer := Disp_PSL_HDL_Expr'Access; - PSL.Prints.Print_Property (Expr); - end Disp_Psl_Expression; - - procedure Disp_Block_Header (Header : Iir_Block_Header; Indent: Count) - is - Chain : Iir; - begin - if Header = Null_Iir then - return; - end if; - Chain := Get_Generic_Chain (Header); - if Chain /= Null_Iir then - Set_Col (Indent + Indentation); - Disp_Generics (Header); - Chain := Get_Generic_Map_Aspect_Chain (Header); - if Chain /= Null_Iir then - Set_Col (Indent + Indentation); - Disp_Generic_Map_Aspect (Header); - Put_Line (";"); - end if; - end if; - Chain := Get_Port_Chain (Header); - if Chain /= Null_Iir then - Set_Col (Indent + Indentation); - Disp_Ports (Header); - Chain := Get_Port_Map_Aspect_Chain (Header); - if Chain /= Null_Iir then - Set_Col (Indent + Indentation); - Disp_Port_Map_Aspect (Header); - Put_Line (";"); - end if; - end if; - end Disp_Block_Header; - - procedure Disp_Block_Statement (Block: Iir_Block_Statement) - is - Indent: Count; - Sensitivity: Iir_List; - Guard : Iir_Guard_Signal_Declaration; - begin - Indent := Col; - Disp_Label (Block); - Put ("block"); - Guard := Get_Guard_Decl (Block); - if Guard /= Null_Iir then - Put (" ("); - Disp_Expression (Get_Guard_Expression (Guard)); - Put_Line (")"); - Sensitivity := Get_Guard_Sensitivity_List (Guard); - if Sensitivity /= Null_Iir_List then - Set_Col (Indent + Indentation); - Put ("-- guard sensitivity list "); - Disp_Designator_List (Sensitivity); - end if; - else - New_Line; - end if; - Disp_Block_Header (Get_Block_Header (Block), - Indent + Indentation); - Disp_Declaration_Chain (Block, Indent + Indentation); - Set_Col (Indent); - Put_Line ("begin"); - Disp_Concurrent_Statement_Chain (Block, Indent + Indentation); - Set_Col (Indent); - Disp_End (Block, "block"); - end Disp_Block_Statement; - - procedure Disp_Generate_Statement (Stmt : Iir_Generate_Statement) - is - Indent : Count; - Scheme : Iir; - begin - Indent := Col; - Disp_Label (Stmt); - Scheme := Get_Generation_Scheme (Stmt); - case Get_Kind (Scheme) is - when Iir_Kind_Iterator_Declaration => - Put ("for "); - Disp_Parameter_Specification (Scheme); - when others => - Put ("if "); - Disp_Expression (Scheme); - end case; - Put_Line (" generate"); - Disp_Declaration_Chain (Stmt, Indent); - if Get_Has_Begin (Stmt) then - Set_Col (Indent); - Put_Line ("begin"); - end if; - Disp_Concurrent_Statement_Chain (Stmt, Indent + Indentation); - Set_Col (Indent); - Disp_End (Stmt, "generate"); - end Disp_Generate_Statement; - - procedure Disp_Psl_Default_Clock (Stmt : Iir) is - begin - Put ("--psl default clock is "); - Disp_Psl_Expression (Get_Psl_Boolean (Stmt)); - Put_Line (";"); - end Disp_Psl_Default_Clock; - - procedure Disp_PSL_NFA (N : PSL.Nodes.NFA) - is - use PSL.NFAs; - use PSL.Nodes; - - procedure Disp_State (S : NFA_State) is - Str : constant String := Int32'Image (Get_State_Label (S)); - begin - Put (Str (2 .. Str'Last)); - end Disp_State; - - S : NFA_State; - E : NFA_Edge; - begin - if N /= No_NFA then - S := Get_First_State (N); - while S /= No_State loop - E := Get_First_Src_Edge (S); - while E /= No_Edge loop - Put ("-- "); - Disp_State (S); - Put (" -> "); - Disp_State (Get_Edge_Dest (E)); - Put (": "); - Disp_Psl_Expression (Get_Edge_Expr (E)); - New_Line; - E := Get_Next_Src_Edge (E); - end loop; - S := Get_Next_State (S); - end loop; - end if; - end Disp_PSL_NFA; - - procedure Disp_Psl_Assert_Statement (Stmt : Iir) is - begin - Put ("--psl assert "); - Disp_Psl_Expression (Get_Psl_Property (Stmt)); - Put_Line (";"); - Disp_PSL_NFA (Get_PSL_NFA (Stmt)); - end Disp_Psl_Assert_Statement; - - procedure Disp_Psl_Cover_Statement (Stmt : Iir) is - begin - Put ("--psl cover "); - Disp_Psl_Expression (Get_Psl_Property (Stmt)); - Put_Line (";"); - Disp_PSL_NFA (Get_PSL_NFA (Stmt)); - end Disp_Psl_Cover_Statement; - - procedure Disp_Simple_Simultaneous_Statement (Stmt : Iir) - is - begin - Disp_Label (Stmt); - Disp_Expression (Get_Simultaneous_Left (Stmt)); - Put (" == "); - Disp_Expression (Get_Simultaneous_Right (Stmt)); - Put_Line (";"); - end Disp_Simple_Simultaneous_Statement; - - procedure Disp_Concurrent_Statement (Stmt: Iir) is - begin - case Get_Kind (Stmt) is - when Iir_Kind_Concurrent_Conditional_Signal_Assignment => - Disp_Concurrent_Conditional_Signal_Assignment (Stmt); - when Iir_Kind_Concurrent_Selected_Signal_Assignment => - Disp_Concurrent_Selected_Signal_Assignment (Stmt); - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - Disp_Process_Statement (Stmt); - when Iir_Kind_Concurrent_Assertion_Statement => - Disp_Assertion_Statement (Stmt); - when Iir_Kind_Component_Instantiation_Statement => - Disp_Component_Instantiation_Statement (Stmt); - when Iir_Kind_Concurrent_Procedure_Call_Statement => - Disp_Label (Stmt); - Disp_Postponed (Stmt); - Disp_Procedure_Call (Get_Procedure_Call (Stmt)); - when Iir_Kind_Block_Statement => - Disp_Block_Statement (Stmt); - when Iir_Kind_Generate_Statement => - Disp_Generate_Statement (Stmt); - when Iir_Kind_Psl_Default_Clock => - Disp_Psl_Default_Clock (Stmt); - when Iir_Kind_Psl_Assert_Statement => - Disp_Psl_Assert_Statement (Stmt); - when Iir_Kind_Psl_Cover_Statement => - Disp_Psl_Cover_Statement (Stmt); - when Iir_Kind_Simple_Simultaneous_Statement => - Disp_Simple_Simultaneous_Statement (Stmt); - when others => - Error_Kind ("disp_concurrent_statement", Stmt); - end case; - end Disp_Concurrent_Statement; - - procedure Disp_Package_Declaration (Decl: Iir_Package_Declaration) - is - Header : constant Iir := Get_Package_Header (Decl); - begin - Put ("package "); - Disp_Identifier (Decl); - Put_Line (" is"); - if Header /= Null_Iir then - Disp_Generics (Header); - New_Line; - end if; - Disp_Declaration_Chain (Decl, Col + Indentation); - Disp_End (Decl, "package"); - end Disp_Package_Declaration; - - procedure Disp_Package_Body (Decl: Iir) - is - begin - Put ("package body "); - Disp_Identifier (Decl); - Put_Line (" is"); - Disp_Declaration_Chain (Decl, Col + Indentation); - Disp_End (Decl, "package body"); - end Disp_Package_Body; - - procedure Disp_Package_Instantiation_Declaration (Decl: Iir) is - begin - Put ("package "); - Disp_Identifier (Decl); - Put_Line (" is new "); - Disp_Name (Get_Uninstantiated_Package_Name (Decl)); - Put (" "); - Disp_Generic_Map_Aspect (Decl); - Put_Line (";"); - end Disp_Package_Instantiation_Declaration; - - procedure Disp_Binding_Indication (Bind : Iir; Indent : Count) - is - El : Iir; - begin - El := Get_Entity_Aspect (Bind); - if El /= Null_Iir then - Set_Col (Indent); - Put ("use "); - Disp_Entity_Aspect (El); - end if; - El := Get_Generic_Map_Aspect_Chain (Bind); - if El /= Null_Iir then - Set_Col (Indent); - Disp_Generic_Map_Aspect (Bind); - end if; - El := Get_Port_Map_Aspect_Chain (Bind); - if El /= Null_Iir then - Set_Col (Indent); - Disp_Port_Map_Aspect (Bind); - end if; - end Disp_Binding_Indication; - - procedure Disp_Component_Configuration - (Conf : Iir_Component_Configuration; Indent : Count) - is - Block : Iir_Block_Configuration; - Binding : Iir; - begin - Set_Col (Indent); - Put ("for "); - Disp_Instantiation_List (Get_Instantiation_List (Conf)); - Put (" : "); - Disp_Name_Of (Get_Component_Name (Conf)); - New_Line; - Binding := Get_Binding_Indication (Conf); - if Binding /= Null_Iir then - Disp_Binding_Indication (Binding, Indent + Indentation); - Put (";"); - end if; - Block := Get_Block_Configuration (Conf); - if Block /= Null_Iir then - Disp_Block_Configuration (Block, Indent + Indentation); - end if; - Set_Col (Indent); - Put_Line ("end for;"); - end Disp_Component_Configuration; - - procedure Disp_Configuration_Items - (Conf : Iir_Block_Configuration; Indent : Count) - is - El : Iir; - begin - El := Get_Configuration_Item_Chain (Conf); - while El /= Null_Iir loop - case Get_Kind (El) is - when Iir_Kind_Block_Configuration => - Disp_Block_Configuration (El, Indent); - when Iir_Kind_Component_Configuration => - Disp_Component_Configuration (El, Indent); - when Iir_Kind_Configuration_Specification => - -- This may be created by canon. - Set_Col (Indent); - Disp_Configuration_Specification (El); - Set_Col (Indent); - Put_Line ("end for;"); - when others => - Error_Kind ("disp_configuration_item_list", El); - end case; - El := Get_Chain (El); - end loop; - end Disp_Configuration_Items; - - procedure Disp_Block_Configuration - (Block: Iir_Block_Configuration; Indent: Count) - is - Spec : Iir; - begin - Set_Col (Indent); - Put ("for "); - Spec := Get_Block_Specification (Block); - case Get_Kind (Spec) is - when Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement - | Iir_Kind_Architecture_Body => - Disp_Name_Of (Spec); - when Iir_Kind_Indexed_Name => - declare - Index_List : constant Iir_List := Get_Index_List (Spec); - begin - Disp_Name_Of (Get_Prefix (Spec)); - Put (" ("); - if Index_List = Iir_List_Others then - Put ("others"); - else - Disp_Expression (Get_First_Element (Index_List)); - end if; - Put (")"); - end; - when Iir_Kind_Slice_Name => - Disp_Name_Of (Get_Prefix (Spec)); - Put (" ("); - Disp_Range (Get_Suffix (Spec)); - Put (")"); - when Iir_Kind_Simple_Name => - Disp_Name (Spec); - when others => - Error_Kind ("disp_block_configuration", Spec); - end case; - New_Line; - Disp_Declaration_Chain (Block, Indent + Indentation); - Disp_Configuration_Items (Block, Indent + Indentation); - Set_Col (Indent); - Put_Line ("end for;"); - end Disp_Block_Configuration; - - procedure Disp_Configuration_Declaration - (Decl: Iir_Configuration_Declaration) - is - begin - Put ("configuration "); - Disp_Name_Of (Decl); - Put (" of "); - Disp_Name (Get_Entity_Name (Decl)); - Put_Line (" is"); - Disp_Declaration_Chain (Decl, Col); - Disp_Block_Configuration (Get_Block_Configuration (Decl), - Col + Indentation); - Disp_End (Decl, "configuration"); - end Disp_Configuration_Declaration; - - procedure Disp_Design_Unit (Unit: Iir_Design_Unit) - is - Indent: constant Count := Col; - Decl: Iir; - Next_Decl : Iir; - begin - Decl := Get_Context_Items (Unit); - while Decl /= Null_Iir loop - Next_Decl := Get_Chain (Decl); - - Set_Col (Indent); - case Get_Kind (Decl) is - when Iir_Kind_Use_Clause => - Disp_Use_Clause (Decl); - when Iir_Kind_Library_Clause => - Put ("library "); - Disp_Identifier (Decl); - while Get_Has_Identifier_List (Decl) loop - Decl := Next_Decl; - Next_Decl := Get_Chain (Decl); - Put (", "); - Disp_Identifier (Decl); - end loop; - Put_Line (";"); - when others => - Error_Kind ("disp_design_unit1", Decl); - end case; - Decl := Next_Decl; - end loop; - - Decl := Get_Library_Unit (Unit); - Set_Col (Indent); - case Get_Kind (Decl) is - when Iir_Kind_Entity_Declaration => - Disp_Entity_Declaration (Decl); - when Iir_Kind_Architecture_Body => - Disp_Architecture_Body (Decl); - when Iir_Kind_Package_Declaration => - Disp_Package_Declaration (Decl); - when Iir_Kind_Package_Body => - Disp_Package_Body (Decl); - when Iir_Kind_Package_Instantiation_Declaration => - Disp_Package_Instantiation_Declaration (Decl); - when Iir_Kind_Configuration_Declaration => - Disp_Configuration_Declaration (Decl); - when others => - Error_Kind ("disp_design_unit2", Decl); - end case; - New_Line; - New_Line; - end Disp_Design_Unit; - - procedure Disp_Vhdl (An_Iir: Iir) is - begin - -- Put (Count'Image (Line_Length)); - case Get_Kind (An_Iir) is - when Iir_Kind_Design_Unit => - Disp_Design_Unit (An_Iir); - when Iir_Kind_Character_Literal => - Disp_Character_Literal (An_Iir); - when Iir_Kind_Enumeration_Type_Definition => - Disp_Enumeration_Type_Definition (An_Iir); - when Iir_Kind_Enumeration_Subtype_Definition => - Disp_Enumeration_Subtype_Definition (An_Iir); - when Iir_Kind_Concurrent_Conditional_Signal_Assignment => - Disp_Concurrent_Conditional_Signal_Assignment (An_Iir); - when Iir_Kinds_Dyadic_Operator => - Disp_Dyadic_Operator (An_Iir); - when Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Object_Alias_Declaration => - Disp_Name_Of (An_Iir); - when Iir_Kind_Enumeration_Literal => - Disp_Identifier (An_Iir); - when Iir_Kind_Component_Instantiation_Statement => - Disp_Component_Instantiation_Statement (An_Iir); - when Iir_Kind_Integer_Subtype_Definition => - Disp_Integer_Subtype_Definition (An_Iir); - when Iir_Kind_Array_Subtype_Definition => - Disp_Array_Subtype_Definition (An_Iir); - when Iir_Kind_Array_Type_Definition => - Disp_Array_Type_Definition (An_Iir); - when Iir_Kind_Package_Declaration => - Disp_Package_Declaration (An_Iir); - when Iir_Kind_Wait_Statement => - Disp_Wait_Statement (An_Iir); - when Iir_Kind_Selected_Name - | Iir_Kind_Selected_Element - | Iir_Kind_Indexed_Name - | Iir_Kind_Slice_Name => - Disp_Expression (An_Iir); - when others => - Error_Kind ("disp", An_Iir); - end case; - end Disp_Vhdl; - - procedure Disp_Int64 (Val: Iir_Int64) - is - Str: constant String := Iir_Int64'Image (Val); - begin - if Str(Str'First) = ' ' then - Put (Str (Str'First + 1 .. Str'Last)); - else - Put (Str); - end if; - end Disp_Int64; - - procedure Disp_Int32 (Val: Iir_Int32) - is - Str: constant String := Iir_Int32'Image (Val); - begin - if Str(Str'First) = ' ' then - Put (Str (Str'First + 1 .. Str'Last)); - else - Put (Str); - end if; - end Disp_Int32; - - procedure Disp_Fp64 (Val: Iir_Fp64) - is - Str: constant String := Iir_Fp64'Image (Val); - begin - if Str(Str'First) = ' ' then - Put (Str (Str'First + 1 .. Str'Last)); - else - Put (Str); - end if; - end Disp_Fp64; -end Disp_Vhdl; diff --git a/disp_vhdl.ads b/disp_vhdl.ads deleted file mode 100644 index 880290efd..000000000 --- a/disp_vhdl.ads +++ /dev/null @@ -1,38 +0,0 @@ --- VHDL regeneration from internal nodes. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Types; use Types; -with Iirs; use Iirs; - -package Disp_Vhdl is - -- General procedure to display a node. - -- Mainly used to dispatch to other functions according to the kind of - -- the node. - procedure Disp_Vhdl (An_Iir: Iir); - - procedure Disp_Expression (Expr: Iir); - -- Display an expression. - - -- Disp an iir_int64, without the leading blank. - procedure Disp_Int64 (Val: Iir_Int64); - - -- Disp an iir_int32, without the leading blank. - procedure Disp_Int32 (Val: Iir_Int32); - - -- Disp an iir_Fp64, without the leading blank. - procedure Disp_Fp64 (Val: Iir_Fp64); -end Disp_Vhdl; diff --git a/errorout.adb b/errorout.adb deleted file mode 100644 index 1652bb43e..000000000 --- a/errorout.adb +++ /dev/null @@ -1,1113 +0,0 @@ --- Error message handling. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Ada.Text_IO; -with Ada.Command_Line; -with Scanner; -with Tokens; use Tokens; -with Name_Table; -with Iirs_Utils; use Iirs_Utils; -with Files_Map; use Files_Map; -with Ada.Strings.Unbounded; -with Std_Names; -with Flags; -with PSL.Nodes; - -package body Errorout is - procedure Put (Str : String) - is - use Ada.Text_IO; - begin - Put (Standard_Error, Str); - end Put; - - procedure Put (C : Character) - is - use Ada.Text_IO; - begin - Put (Standard_Error, C); - end Put; - - procedure Put_Line (Str : String) - is - use Ada.Text_IO; - begin - Put_Line (Standard_Error, Str); - end Put_Line; - - procedure Disp_Natural (Val: Natural) - is - Str: constant String := Natural'Image (Val); - begin - Put (Str(Str'First + 1 .. Str'Last)); - end Disp_Natural; - - procedure Error_Msg (Msg: String) is - begin - Put (Ada.Command_Line.Command_Name); - Put (": "); - Put_Line (Msg); - end Error_Msg; - - procedure Error_Kind (Msg : String; An_Iir : Iir) is - begin - Put_Line (Msg & ": cannot handle " - & Iir_Kind'Image (Get_Kind (An_Iir)) - & " (" & Disp_Location (An_Iir) & ')'); - raise Internal_Error; - end Error_Kind; - - procedure Error_Kind (Msg : String; Def : Iir_Predefined_Functions) is - begin - Put_Line (Msg & ": cannot handle " - & Iir_Predefined_Functions'Image (Def)); - raise Internal_Error; - end Error_Kind; - - procedure Error_Kind (Msg : String; N : PSL_Node) is - begin - Put (Msg); - Put (": cannot handle "); - Put_Line (PSL.Nodes.Nkind'Image (PSL.Nodes.Get_Kind (N))); - raise Internal_Error; - end Error_Kind; - - procedure Error_Msg_Option_NR (Msg: String) is - begin - Put (Ada.Command_Line.Command_Name); - Put (": "); - Put_Line (Msg); - end Error_Msg_Option_NR; - - procedure Error_Msg_Option (Msg: String) is - begin - Error_Msg_Option_NR (Msg); - raise Option_Error; - end Error_Msg_Option; - - procedure Disp_Location - (File: Name_Id; Line: Natural; Col: Natural) is - begin - Put (Name_Table.Image (File)); - Put (':'); - Disp_Natural (Line); - Put (':'); - Disp_Natural (Col); - Put (':'); - end Disp_Location; - - procedure Disp_Current_Location is - begin - Disp_Location (Scanner.Get_Current_File, - Scanner.Get_Current_Line, - Scanner.Get_Current_Column); - end Disp_Current_Location; - - procedure Disp_Token_Location is - begin - Disp_Location (Scanner.Get_Current_File, - Scanner.Get_Current_Line, - Scanner.Get_Token_Column); - end Disp_Token_Location; - - procedure Disp_Location (Loc : Location_Type) - is - Name : Name_Id; - Line : Natural; - Col : Natural; - begin - if Loc = Location_Nil then - -- Avoid a crash, but should not happen. - Put ("??:??:??:"); - else - Location_To_Position (Loc, Name, Line, Col); - Disp_Location (Name, Line, Col); - end if; - end Disp_Location; - - function Get_Location_Safe (N : Iir) return Location_Type is - begin - if N = Null_Iir then - return Location_Nil; - else - return Get_Location (N); - end if; - end Get_Location_Safe; - - procedure Disp_Iir_Location (An_Iir: Iir) is - begin - Disp_Location (Get_Location_Safe (An_Iir)); - end Disp_Iir_Location; - - procedure Disp_PSL_Location (N : PSL_Node) is - begin - Disp_Location (PSL.Nodes.Get_Location (N)); - end Disp_PSL_Location; - - procedure Warning_Msg (Msg: String) is - begin - Put ("warning: "); - Put_Line (Msg); - end Warning_Msg; - - procedure Warning_Msg_Parse (Msg: String) is - begin - if Flags.Flag_Only_Elab_Warnings then - return; - end if; - Disp_Token_Location; - if Flags.Warn_Error then - Nbr_Errors := Nbr_Errors + 1; - Put (" "); - else - Put ("warning: "); - end if; - Put_Line (Msg); - end Warning_Msg_Parse; - - procedure Warning_Msg_Sem (Msg: String; Loc : Location_Type) is - begin - if Flags.Flag_Only_Elab_Warnings then - return; - end if; - Disp_Location (Loc); - if Flags.Warn_Error then - Nbr_Errors := Nbr_Errors + 1; - Put (" "); - else - Put ("warning: "); - end if; - Put_Line (Msg); - end Warning_Msg_Sem; - - procedure Warning_Msg_Sem (Msg: String; Loc : Iir) is - begin - Warning_Msg_Sem (Msg, Get_Location_Safe (Loc)); - end Warning_Msg_Sem; - - procedure Warning_Msg_Elab (Msg: String; Loc : Location_Type) is - begin - Disp_Location (Loc); - if Flags.Warn_Error then - Nbr_Errors := Nbr_Errors + 1; - Put (" "); - else - Put ("warning: "); - end if; - Put_Line (Msg); - end Warning_Msg_Elab; - - procedure Warning_Msg_Elab (Msg: String; Loc : Iir) is - begin - Warning_Msg_Elab (Msg, Get_Location_Safe (Loc)); - end Warning_Msg_Elab; - - procedure Disp_Current_Token; - pragma Unreferenced (Disp_Current_Token); - - procedure Disp_Current_Token is - begin - case Scanner.Current_Token is - when Tok_Identifier => - Put ("identifier """ - & Name_Table.Image (Scanner.Current_Identifier) & """"); - when others => - Put (Token_Type'Image (Scanner.Current_Token)); - end case; - end Disp_Current_Token; - - -- Disp a message during scan. - procedure Error_Msg_Scan (Msg: String) is - begin - Nbr_Errors := Nbr_Errors + 1; - Disp_Current_Location; - Put (' '); - Put_Line (Msg); - end Error_Msg_Scan; - - procedure Error_Msg_Scan (Msg: String; Loc : Location_Type) is - begin - Nbr_Errors := Nbr_Errors + 1; - Disp_Location (Loc); - Put (' '); - Put_Line (Msg); - end Error_Msg_Scan; - - -- Disp a message during scan. - procedure Warning_Msg_Scan (Msg: String) is - begin - Disp_Current_Location; - Put ("warning: "); - Put_Line (Msg); - end Warning_Msg_Scan; - - -- Disp a message during scan. - procedure Error_Msg_Parse (Msg: String) is - begin - Nbr_Errors := Nbr_Errors + 1; - Disp_Token_Location; - Put (' '); - Put_Line (Msg); - end Error_Msg_Parse; - - procedure Error_Msg_Parse (Msg: String; Loc : Iir) is - begin - Nbr_Errors := Nbr_Errors + 1; - Disp_Iir_Location (Loc); - Put (' '); - Put_Line (Msg); - end Error_Msg_Parse; - - procedure Error_Msg_Parse (Msg: String; Loc : Location_Type) is - begin - Nbr_Errors := Nbr_Errors + 1; - Disp_Location (Loc); - Put (' '); - Put_Line (Msg); - end Error_Msg_Parse; - - -- Disp a message during semantic analysis. - -- LOC is used for location and current token. - procedure Error_Msg_Sem (Msg: String; Loc: in Iir) is - begin - Nbr_Errors := Nbr_Errors + 1; - if Loc /= Null_Iir then - Disp_Iir_Location (Loc); - Put (' '); - end if; - Put_Line (Msg); - end Error_Msg_Sem; - - procedure Error_Msg_Sem (Msg: String; Loc: PSL_Node) is - use PSL.Nodes; - begin - Nbr_Errors := Nbr_Errors + 1; - if Loc /= Null_Node then - Disp_PSL_Location (Loc); - Put (' '); - end if; - Put_Line (Msg); - end Error_Msg_Sem; - - procedure Error_Msg_Sem (Msg: String; Loc : Location_Type) is - begin - Nbr_Errors := Nbr_Errors + 1; - Disp_Location (Loc); - Put (' '); - Put_Line (Msg); - end Error_Msg_Sem; - - -- Disp a message during elaboration. - procedure Error_Msg_Elab (Msg: String) is - begin - Nbr_Errors := Nbr_Errors + 1; - Put ("error: "); - Put_Line (Msg); - end Error_Msg_Elab; - - procedure Error_Msg_Elab (Msg: String; Loc : Iir) is - begin - Nbr_Errors := Nbr_Errors + 1; - Disp_Iir_Location (Loc); - Put (' '); - Put_Line (Msg); - end Error_Msg_Elab; - - -- Disp a bug message. - procedure Error_Internal (Expr: in Iir; Msg: String := "") - is - pragma Unreferenced (Expr); - begin - Put ("internal error: "); - Put_Line (Msg); - raise Internal_Error; - end Error_Internal; - - function Disp_Label (Node : Iir; Str : String) return String - is - Id : Name_Id; - begin - Id := Get_Label (Node); - if Id = Null_Identifier then - return "(unlabeled) " & Str; - else - return Str & " labeled """ & Name_Table.Image (Id) & """"; - end if; - end Disp_Label; - - -- Disp a node. - -- Used for output of message. - function Disp_Node (Node: Iir) return String is - function Disp_Identifier (Node : Iir; Str : String) return String - is - Id : Name_Id; - begin - Id := Get_Identifier (Node); - return Str & " """ & Name_Table.Image (Id) & """"; - end Disp_Identifier; - - function Disp_Type (Node : Iir; Str : String) return String - is - Decl: Iir; - begin - Decl := Get_Type_Declarator (Node); - if Decl = Null_Iir then - return "the anonymous " & Str - & " defined at " & Disp_Location (Node); - else - return Disp_Identifier (Decl, Str); - end if; - end Disp_Type; - - begin - case Get_Kind (Node) is - when Iir_Kind_String_Literal => - return "string literal """ - & Image_String_Lit (Node) & """"; - when Iir_Kind_Bit_String_Literal => - return "bit string literal """ - & Image_String_Lit (Node) & """"; - when Iir_Kind_Character_Literal => - return "character literal " & Image_Identifier (Node); - when Iir_Kind_Integer_Literal => - return "integer literal"; - when Iir_Kind_Floating_Point_Literal => - return "floating point literal"; - when Iir_Kind_Physical_Int_Literal - | Iir_Kind_Physical_Fp_Literal => - return "physical literal"; - when Iir_Kind_Enumeration_Literal => - return "enumeration literal " & Image_Identifier (Node); - when Iir_Kind_Element_Declaration => - return Disp_Identifier (Node, "element"); - when Iir_Kind_Record_Element_Constraint => - return "record element constraint"; - when Iir_Kind_Array_Element_Resolution => - return "array element resolution"; - when Iir_Kind_Record_Resolution => - return "record resolution"; - when Iir_Kind_Record_Element_Resolution => - return "record element resolution"; - when Iir_Kind_Null_Literal => - return "null literal"; - when Iir_Kind_Overflow_Literal => - return Disp_Node (Get_Literal_Origin (Node)); - when Iir_Kind_Aggregate => - return "aggregate"; - when Iir_Kind_Unit_Declaration => - return Disp_Identifier (Node, "physical unit"); - when Iir_Kind_Simple_Aggregate => - return "locally static array literal"; - - when Iir_Kind_Operator_Symbol => - return "operator name"; - when Iir_Kind_Aggregate_Info => - return "aggregate info"; - when Iir_Kind_Signature => - return "signature"; - when Iir_Kind_Waveform_Element => - return "waveform element"; - when Iir_Kind_Conditional_Waveform => - return "conditional waveform"; - when Iir_Kind_Association_Element_Open => - return "open association element"; - when Iir_Kind_Association_Element_By_Individual => - return "individual association element"; - when Iir_Kind_Association_Element_By_Expression - | Iir_Kind_Association_Element_Package => - return "association element"; - when Iir_Kind_Overload_List => - return "overloaded name or expression"; - - when Iir_Kind_Integer_Type_Definition - | Iir_Kind_Enumeration_Type_Definition => - return Image_Identifier (Get_Type_Declarator (Node)); - when Iir_Kind_Array_Type_Definition => - return Disp_Type (Node, "array type"); - when Iir_Kind_Array_Subtype_Definition => - return Disp_Type (Node, "array subtype"); - when Iir_Kind_Record_Type_Definition => - return Disp_Type (Node, "record type"); - when Iir_Kind_Record_Subtype_Definition => - return Disp_Type (Node, "record subtype"); - when Iir_Kind_Enumeration_Subtype_Definition => - return Disp_Type (Node, "enumeration subtype"); - when Iir_Kind_Integer_Subtype_Definition => - return Disp_Type (Node, "integer subtype"); - when Iir_Kind_Physical_Type_Definition => - return Disp_Type (Node, "physical type"); - when Iir_Kind_Physical_Subtype_Definition => - return Disp_Type (Node, "physical subtype"); - when Iir_Kind_File_Type_Definition => - return Disp_Type (Node, "file type"); - when Iir_Kind_Access_Type_Definition => - return Disp_Type (Node, "access type"); - when Iir_Kind_Access_Subtype_Definition => - return Disp_Type (Node, "access subtype"); - when Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Floating_Type_Definition => - return Disp_Type (Node, "floating type"); - when Iir_Kind_Incomplete_Type_Definition => - return Disp_Type (Node, "incomplete type"); - when Iir_Kind_Protected_Type_Declaration => - return Disp_Type (Node, "protected type"); - when Iir_Kind_Protected_Type_Body => - return Disp_Type (Node, "protected type body"); - when Iir_Kind_Subtype_Definition => - return "subtype definition"; - - when Iir_Kind_Scalar_Nature_Definition => - return Image_Identifier (Get_Nature_Declarator (Node)); - - when Iir_Kind_Choice_By_Expression => - return "choice by expression"; - when Iir_Kind_Choice_By_Range => - return "choice by range"; - when Iir_Kind_Choice_By_Name => - return "choice by name"; - when Iir_Kind_Choice_By_Others => - return "others choice"; - when Iir_Kind_Choice_By_None => - return "positionnal choice"; - - when Iir_Kind_Function_Call => - return "function call"; - when Iir_Kind_Procedure_Call_Statement => - return "procedure call statement"; - when Iir_Kind_Procedure_Call => - return "procedure call"; - when Iir_Kind_Selected_Name => - Name_Table.Image (Get_Identifier (Node)); - return ''' - & Name_Table.Name_Buffer (1 .. Name_Table.Name_Length) - & '''; - when Iir_Kind_Simple_Name => - Name_Table.Image (Get_Identifier (Node)); - return ''' - & Name_Table.Name_Buffer (1 .. Name_Table.Name_Length) - & '''; - when Iir_Kind_Entity_Aspect_Entity => - return "aspect " & Disp_Node (Get_Entity (Node)) - & '(' & Image_Identifier (Get_Architecture (Node)) & ')'; - when Iir_Kind_Entity_Aspect_Configuration => - return "configuration entity aspect"; - when Iir_Kind_Entity_Aspect_Open => - return "open entity aspect"; - - when Iir_Kinds_Monadic_Operator - | Iir_Kinds_Dyadic_Operator => - return "operator """ - & Name_Table.Image (Get_Operator_Name (Node)) & """"; - when Iir_Kind_Parenthesis_Expression => - return "expression"; - when Iir_Kind_Qualified_Expression => - return "qualified expression"; - when Iir_Kind_Type_Conversion => - return "type conversion"; - when Iir_Kind_Allocator_By_Subtype - | Iir_Kind_Allocator_By_Expression => - return "allocator"; - when Iir_Kind_Indexed_Name => - return "indexed name"; - when Iir_Kind_Range_Expression => - return "range expression"; - when Iir_Kind_Implicit_Dereference => - return "implicit access dereference"; - when Iir_Kind_Dereference => - return "access dereference"; - when Iir_Kind_Selected_Element => - return "selected element"; - when Iir_Kind_Selected_By_All_Name => - return ".all name"; - when Iir_Kind_Psl_Expression => - return "PSL instantiation"; - - when Iir_Kind_Interface_Constant_Declaration => - if Get_Parent (Node) = Null_Iir then - -- For constant interface of predefined operator. - return "anonymous interface"; - end if; - case Get_Kind (Get_Parent (Node)) is - when Iir_Kind_Entity_Declaration - | Iir_Kind_Block_Statement - | Iir_Kind_Block_Header => - return Disp_Identifier (Node, "generic"); - when others => - return Disp_Identifier (Node, "constant interface"); - end case; - when Iir_Kind_Interface_Signal_Declaration => - case Get_Kind (Get_Parent (Node)) is - when Iir_Kind_Entity_Declaration - | Iir_Kind_Block_Statement - | Iir_Kind_Block_Header => - return Disp_Identifier (Node, "port"); - when others => - return Disp_Identifier (Node, "signal interface"); - end case; - when Iir_Kind_Interface_Variable_Declaration => - return Disp_Identifier (Node, "variable interface"); - when Iir_Kind_Interface_File_Declaration => - return Disp_Identifier (Node, "file interface"); - when Iir_Kind_Interface_Package_Declaration => - return Disp_Identifier (Node, "package interface"); - when Iir_Kind_Signal_Declaration => - return Disp_Identifier (Node, "signal"); - when Iir_Kind_Variable_Declaration => - return Disp_Identifier (Node, "variable"); - when Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Declaration => - return Disp_Identifier (Node, "constant"); - when Iir_Kind_File_Declaration => - return Disp_Identifier (Node, "file"); - when Iir_Kind_Object_Alias_Declaration => - return Disp_Identifier (Node, "alias"); - when Iir_Kind_Non_Object_Alias_Declaration => - return Disp_Identifier (Node, "non-object alias"); - when Iir_Kind_Guard_Signal_Declaration => - return "GUARD signal"; - when Iir_Kind_Group_Template_Declaration => - return Disp_Identifier (Node, "group template"); - when Iir_Kind_Group_Declaration => - return Disp_Identifier (Node, "group"); - - when Iir_Kind_Library_Declaration - | Iir_Kind_Library_Clause => - return Disp_Identifier (Node, "library"); - when Iir_Kind_Design_File => - return "design file"; - - when Iir_Kind_Procedure_Declaration => - return Disp_Identifier (Node, "procedure"); - when Iir_Kind_Procedure_Body - | Iir_Kind_Function_Body => - return "subprogram body"; - when Iir_Kind_Function_Declaration => - return Disp_Identifier (Node, "function"); - - when Iir_Kind_Package_Declaration => - return Disp_Identifier (Node, "package"); - when Iir_Kind_Package_Body => - return Disp_Identifier (Node, "package body"); - when Iir_Kind_Entity_Declaration => - return Disp_Identifier (Node, "entity"); - when Iir_Kind_Architecture_Body => - return Disp_Identifier (Node, "architecture") & - " of" & Disp_Identifier (Get_Entity_Name (Node), ""); - when Iir_Kind_Configuration_Declaration => - declare - Id : Name_Id; - Ent : Iir; - Arch : Iir; - begin - Id := Get_Identifier (Node); - if Id /= Null_Identifier then - return Disp_Identifier (Node, "configuration"); - else - Ent := Get_Entity (Node); - Arch := Get_Block_Specification - (Get_Block_Configuration (Node)); - return "default configuration of " - & Image_Identifier (Ent) - & '(' & Image_Identifier (Arch) & ')'; - end if; - end; - when Iir_Kind_Package_Instantiation_Declaration => - return Disp_Identifier (Node, "instantiation package"); - - when Iir_Kind_Package_Header => - return "package header"; - - when Iir_Kind_Component_Declaration => - return Disp_Identifier (Node, "component"); - - when Iir_Kind_Design_Unit => - return Disp_Node (Get_Library_Unit (Node)); - when Iir_Kind_Use_Clause => - return "use clause"; - when Iir_Kind_Disconnection_Specification => - return "disconnection specification"; - - when Iir_Kind_Slice_Name => - return "slice"; - when Iir_Kind_Parenthesis_Name => - return "function call, slice or indexed name"; - when Iir_Kind_Type_Declaration => - return Disp_Identifier (Node, "type"); - when Iir_Kind_Anonymous_Type_Declaration => - return Disp_Identifier (Node, "type"); - when Iir_Kind_Subtype_Declaration => - return Disp_Identifier (Node, "subtype"); - - when Iir_Kind_Nature_Declaration => - return Disp_Identifier (Node, "nature"); - when Iir_Kind_Subnature_Declaration => - return Disp_Identifier (Node, "subnature"); - - when Iir_Kind_Component_Instantiation_Statement => - return Disp_Identifier (Node, "component instance"); - when Iir_Kind_Configuration_Specification => - return "configuration specification"; - when Iir_Kind_Component_Configuration => - return "component configuration"; - when Iir_Kind_Implicit_Function_Declaration => - return Disp_Identifier (Node, "implicit function") - & Disp_Identifier (Get_Type_Reference (Node), " of type"); --- return "implicit function " --- & Get_Predefined_Function_Name --- (Get_Implicit_Definition (Node)); - when Iir_Kind_Implicit_Procedure_Declaration => - return "implicit procedure " - & Get_Predefined_Function_Name (Get_Implicit_Definition (Node)); - - when Iir_Kind_Concurrent_Procedure_Call_Statement => - return "concurrent procedure call"; - when Iir_Kind_Generate_Statement => - return "generate statement"; - - when Iir_Kind_Simple_Simultaneous_Statement => - return "simple simultaneous statement"; - - when Iir_Kind_Psl_Declaration => - return Disp_Identifier (Node, "PSL declaration"); - - when Iir_Kind_Terminal_Declaration => - return Disp_Identifier (Node, "terminal declaration"); - when Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration => - return Disp_Identifier (Node, "quantity declaration"); - - when Iir_Kind_Attribute_Declaration => - return Disp_Identifier (Node, "attribute"); - when Iir_Kind_Attribute_Specification => - return "attribute specification"; - when Iir_Kind_Entity_Class => - return "entity class"; - when Iir_Kind_Attribute_Value => - return "attribute value"; - when Iir_Kind_Attribute_Name => - return "attribute"; - when Iir_Kind_Base_Attribute => - return "'base attribute"; - when Iir_Kind_Length_Array_Attribute => - return "'length attribute"; - when Iir_Kind_Range_Array_Attribute => - return "'range attribute"; - when Iir_Kind_Reverse_Range_Array_Attribute => - return "'reverse_range attribute"; - when Iir_Kind_Ascending_Type_Attribute - | Iir_Kind_Ascending_Array_Attribute => - return "'ascending attribute"; - when Iir_Kind_Left_Type_Attribute - | Iir_Kind_Left_Array_Attribute => - return "'left attribute"; - when Iir_Kind_Right_Type_Attribute - | Iir_Kind_Right_Array_Attribute => - return "'right attribute"; - when Iir_Kind_Low_Type_Attribute - | Iir_Kind_Low_Array_Attribute => - return "'low attribute"; - when Iir_Kind_Leftof_Attribute => - return "'leftof attribute"; - when Iir_Kind_Rightof_Attribute => - return "'rightof attribute"; - when Iir_Kind_Pred_Attribute => - return "'pred attribute"; - when Iir_Kind_Succ_Attribute => - return "'succ attribute"; - when Iir_Kind_Pos_Attribute => - return "'pos attribute"; - when Iir_Kind_Val_Attribute => - return "'val attribute"; - when Iir_Kind_Image_Attribute => - return "'image attribute"; - when Iir_Kind_Value_Attribute => - return "'value attribute"; - when Iir_Kind_High_Type_Attribute - | Iir_Kind_High_Array_Attribute => - return "'high attribute"; - when Iir_Kind_Transaction_Attribute => - return "'transaction attribute"; - when Iir_Kind_Stable_Attribute => - return "'stable attribute"; - when Iir_Kind_Quiet_Attribute => - return "'quiet attribute"; - when Iir_Kind_Delayed_Attribute => - return "'delayed attribute"; - when Iir_Kind_Driving_Attribute => - return "'driving attribute"; - when Iir_Kind_Driving_Value_Attribute => - return "'driving_value attribute"; - when Iir_Kind_Event_Attribute => - return "'event attribute"; - when Iir_Kind_Active_Attribute => - return "'active attribute"; - when Iir_Kind_Last_Event_Attribute => - return "'last_event attribute"; - when Iir_Kind_Last_Active_Attribute => - return "'last_active attribute"; - when Iir_Kind_Last_Value_Attribute => - return "'last_value attribute"; - when Iir_Kind_Behavior_Attribute => - return "'behavior attribute"; - when Iir_Kind_Structure_Attribute => - return "'structure attribute"; - - when Iir_Kind_Path_Name_Attribute => - return "'path_name attribute"; - when Iir_Kind_Instance_Name_Attribute => - return "'instance_name attribute"; - when Iir_Kind_Simple_Name_Attribute => - return "'simple_name attribute"; - - when Iir_Kind_For_Loop_Statement => - return Disp_Label (Node, "for loop statement"); - when Iir_Kind_While_Loop_Statement => - return Disp_Label (Node, "loop statement"); - when Iir_Kind_Process_Statement - | Iir_Kind_Sensitized_Process_Statement => - return Disp_Label (Node, "process"); - when Iir_Kind_Block_Statement => - return Disp_Label (Node, "block statement"); - when Iir_Kind_Block_Header => - return "block header"; - when Iir_Kind_Concurrent_Conditional_Signal_Assignment => - return Disp_Label - (Node, "concurrent conditional signal assignment"); - when Iir_Kind_Concurrent_Selected_Signal_Assignment => - return Disp_Label - (Node, "concurrent selected signal assignment"); - when Iir_Kind_Concurrent_Assertion_Statement => - return Disp_Label (Node, "concurrent assertion"); - when Iir_Kind_Psl_Assert_Statement => - return Disp_Label (Node, "PSL assertion"); - when Iir_Kind_Psl_Cover_Statement => - return Disp_Label (Node, "PSL cover"); - when Iir_Kind_Psl_Default_Clock => - return "PSL default clock"; - - when Iir_Kind_If_Statement => - return Disp_Label (Node, "if statement"); - when Iir_Kind_Elsif => - return Disp_Label (Node, "else/elsif statement"); - when Iir_Kind_Next_Statement => - return Disp_Label (Node, "next statement"); - when Iir_Kind_Exit_Statement => - return Disp_Label (Node, "exit statement"); - when Iir_Kind_Case_Statement => - return Disp_Label (Node, "case statement"); - when Iir_Kind_Return_Statement => - return Disp_Label (Node, "return statement"); - when Iir_Kind_Signal_Assignment_Statement => - return Disp_Label (Node, "signal assignment statement"); - when Iir_Kind_Variable_Assignment_Statement => - return Disp_Label (Node, "variable assignment statement"); - when Iir_Kind_Null_Statement => - return Disp_Label (Node, "null statement"); - when Iir_Kind_Wait_Statement => - return Disp_Label (Node, "wait statement"); - when Iir_Kind_Assertion_Statement => - return Disp_Label (Node, "assertion statement"); - when Iir_Kind_Report_Statement => - return Disp_Label (Node, "report statement"); - - when Iir_Kind_Block_Configuration => - return "block configuration"; - when Iir_Kind_Binding_Indication => - return "binding indication"; - - when Iir_Kind_Error => - return "error"; - when Iir_Kind_Unused => - return "*unused*"; - end case; - end Disp_Node; - - -- Disp a node location. - -- Used for output of message. - - function Get_Location_Str - (Name : Name_Id; Line, Col : Natural; Filename : Boolean) - return String - is - Line_Str : constant String := Natural'Image (Line); - Col_Str : constant String := Natural'Image (Col); - begin - if Filename then - return Name_Table.Image (Name) - & ':' & Line_Str (Line_Str'First + 1 .. Line_Str'Last) - & ':' & Col_Str (Col_Str'First + 1 .. Col_Str'Last); - else - return Line_Str (Line_Str'First + 1 .. Line_Str'Last) - & ':' & Col_Str (Col_Str'First + 1 .. Col_Str'Last); - end if; - end Get_Location_Str; - - function Get_Location_Str (Loc : Location_Type; Filename : Boolean := True) - return string - is - Line, Col : Natural; - Name : Name_Id; - begin - if Loc = Location_Nil then - -- Avoid a crash. - return "??:??:??"; - else - Location_To_Position (Loc, Name, Line, Col); - return Get_Location_Str (Name, Line, Col, Filename); - end if; - end Get_Location_Str; - - function Disp_Location (Node: Iir) return String is - begin - return Get_Location_Str (Get_Location (Node)); - end Disp_Location; - - function Disp_Name (Kind : Iir_Kind) return String is - begin - case Kind is - when Iir_Kind_Constant_Declaration => - return "constant declaration"; - when Iir_Kind_Signal_Declaration => - return "signal declaration"; - when Iir_Kind_Variable_Declaration => - return "variable declaration"; - when Iir_Kind_File_Declaration => - return "file declaration"; - when others => - return "???" & Iir_Kind'Image (Kind); - end case; - end Disp_Name; - - function Image (N : Iir_Int64) return String - is - Res : constant String := Iir_Int64'Image (N); - begin - if Res (1) = ' ' then - return Res (2 .. Res'Last); - else - return Res; - end if; - end Image; - - function Disp_Discrete (Dtype : Iir; Pos : Iir_Int64) return String is - begin - case Get_Kind (Dtype) is - when Iir_Kind_Integer_Type_Definition => - return Image (Pos); - when Iir_Kind_Enumeration_Type_Definition => - return Name_Table.Image - (Get_Identifier (Get_Nth_Element - (Get_Enumeration_Literal_List (Dtype), - Natural (Pos)))); - when others => - Error_Kind ("disp_discrete", Dtype); - end case; - end Disp_Discrete; - - function Disp_Subprg (Subprg : Iir) return String - is - use Ada.Strings.Unbounded; - Res : Unbounded_String; - - procedure Append_Type (Def : Iir) - is - use Name_Table; - Decl : Iir := Get_Type_Declarator (Def); - begin - if Decl = Null_Iir then - Decl := Get_Type_Declarator (Get_Base_Type (Def)); - end if; - Image (Get_Identifier (Decl)); - Append (Res, Name_Buffer (1 .. Name_Length)); - end Append_Type; - - begin - case Get_Kind (Subprg) is - when Iir_Kind_Enumeration_Literal => - Append (Res, "enumeration literal "); - when Iir_Kind_Implicit_Function_Declaration => - Append (Res, "implicit function "); - when Iir_Kind_Implicit_Procedure_Declaration => - Append (Res, "implicit procedure "); - when Iir_Kind_Function_Declaration => - Append (Res, "function "); - when Iir_Kind_Procedure_Declaration => - Append (Res, "procedure "); - when others => - Error_Kind ("disp_subprg", Subprg); - end case; - - declare - use Name_Table; - - Id : constant Name_Id := Get_Identifier (Subprg); - begin - Image (Id); - case Id is - when Std_Names.Name_Id_Operators - | Std_Names.Name_Word_Operators - | Std_Names.Name_Xnor - | Std_Names.Name_Shift_Operators => - Append (Res, """"); - Append (Res, Name_Buffer (1 .. Name_Length)); - Append (Res, """"); - when others => - Append (Res, Name_Buffer (1 .. Name_Length)); - end case; - end; - - Append (Res, " ["); - - case Get_Kind (Subprg) is - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => - declare - El : Iir; - begin - El := Get_Interface_Declaration_Chain (Subprg); - while El /= Null_Iir loop - Append_Type (Get_Type (El)); - El := Get_Chain (El); - exit when El = Null_Iir; - Append (Res, ", "); - end loop; - end; - when others => - null; - end case; - - case Get_Kind (Subprg) is - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Function_Declaration - | Iir_Kind_Enumeration_Literal => - Append (Res, " return "); - Append_Type (Get_Return_Type (Subprg)); - when others => - null; - end case; - - Append (Res, "]"); - - return To_String (Res); - end Disp_Subprg; - - -- DEF must be any type definition. - -- Return the type name of DEF, handle anonymous subtypes. - function Disp_Type_Name (Def : Iir) return String - is - Decl : Iir; - begin - Decl := Get_Type_Declarator (Def); - if Decl /= Null_Iir then - return Image_Identifier (Decl); - end if; - Decl := Get_Type_Declarator (Get_Base_Type (Def)); - if Decl /= Null_Iir then - return "a subtype of " & Image_Identifier (Decl); - else - return "an unknown type"; - end if; - end Disp_Type_Name; - - function Disp_Type_Of (Node : Iir) return String - is - A_Type : Iir; - begin - A_Type := Get_Type (Node); - if A_Type = Null_Iir then - return "unknown"; - elsif Get_Kind (A_Type) = Iir_Kind_Overload_List then - declare - use Ada.Strings.Unbounded; - Res : Unbounded_String; - List : Iir_List; - El : Iir; - Nbr : Natural; - begin - List := Get_Overload_List (A_Type); - Nbr := Get_Nbr_Elements (List); - if Nbr = 0 then - return "unknown"; - elsif Nbr = 1 then - return Disp_Type_Name (Get_First_Element (List)); - else - Append (Res, "one of "); - for I in 0 .. Nbr - 1 loop - El := Get_Nth_Element (List, I); - Append (Res, Disp_Type_Name (El)); - if I < Nbr - 2 then - Append (Res, ", "); - elsif I = Nbr - 2 then - Append (Res, " or "); - end if; - end loop; - return To_String (Res); - end if; - end; - else - return Disp_Type_Name (A_Type); - end if; - end Disp_Type_Of; - - procedure Error_Pure (Caller : Iir; Callee : Iir; Loc : Iir) - is - L : Location_Type; - begin - if Loc = Null_Iir then - L := Get_Location (Caller); - else - L := Get_Location (Loc); - end if; - Error_Msg_Sem - ("pure " & Disp_Node (Caller) & " cannot call (impure) " - & Disp_Node (Callee), L); - Error_Msg_Sem - ("(" & Disp_Node (Callee) & " is defined here)", Callee); - end Error_Pure; - - procedure Error_Not_Match (Expr: Iir; A_Type: Iir; Loc : Iir) - is - begin - Error_Msg_Sem ("can't match " & Disp_Node (Expr) & " with type " - & Disp_Node (A_Type), Loc); - if Loc /= Expr then - Error_Msg_Sem ("(location of " & Disp_Node (Expr) & ")", Expr); - end if; - end Error_Not_Match; - - function Get_Mode_Name (Mode : Iir_Mode) return String is - begin - case Mode is - when Iir_Unknown_Mode => - raise Internal_Error; - when Iir_Linkage_Mode => - return "linkage"; - when Iir_Buffer_Mode => - return "buffer"; - when Iir_Out_Mode => - return "out"; - when Iir_Inout_Mode => - return "inout"; - when Iir_In_Mode => - return "in"; - end case; - end Get_Mode_Name; - -end Errorout; diff --git a/errorout.ads b/errorout.ads deleted file mode 100644 index ce694fe37..000000000 --- a/errorout.ads +++ /dev/null @@ -1,128 +0,0 @@ --- Error message handling. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Types; use Types; -with Iirs; use Iirs; - -package Errorout is - Option_Error: exception; - Parse_Error: exception; - Compilation_Error: exception; - - -- This kind can't be handled. - --procedure Error_Kind (Msg: String; Kind: Iir_Kind); - procedure Error_Kind (Msg: String; An_Iir: in Iir); - procedure Error_Kind (Msg: String; Def : Iir_Predefined_Functions); - procedure Error_Kind (Msg : String; N : PSL_Node); - pragma No_Return (Error_Kind); - - -- The number of errors (ie, number of calls to error_msg*). - Nbr_Errors: Natural := 0; - - -- Disp an error, prepended with program name. - procedure Error_Msg (Msg: String); - - -- Disp an error, prepended with program name, and raise option_error. - -- This is used for errors before initialisation, such as bad option or - -- bad filename. - procedure Error_Msg_Option (Msg: String); - pragma No_Return (Error_Msg_Option); - - -- Same as Error_Msg_Option but do not raise Option_Error. - procedure Error_Msg_Option_NR (Msg: String); - - -- Disp an error location (using AN_IIR location) using the standard - -- format `file:line:col: '. - procedure Disp_Iir_Location (An_Iir: Iir); - - -- Disp a warning. - procedure Warning_Msg (Msg: String); - procedure Warning_Msg_Parse (Msg: String); - procedure Warning_Msg_Sem (Msg: String; Loc : Iir); - procedure Warning_Msg_Sem (Msg: String; Loc : Location_Type); - - -- Disp a message during scan. - -- The current location is automatically displayed before the message. - procedure Error_Msg_Scan (Msg: String); - procedure Error_Msg_Scan (Msg: String; Loc : Location_Type); - procedure Warning_Msg_Scan (Msg: String); - - -- Disp a message during parse - -- The location of the current token is automatically displayed before - -- the message. - procedure Error_Msg_Parse (Msg: String); - procedure Error_Msg_Parse (Msg: String; Loc : Iir); - procedure Error_Msg_Parse (Msg: String; Loc : Location_Type); - - -- Disp a message during semantic analysis. - -- an_iir is used for location and current token. - procedure Error_Msg_Sem (Msg: String; Loc: Iir); - procedure Error_Msg_Sem (Msg: String; Loc: PSL_Node); - procedure Error_Msg_Sem (Msg: String; Loc: Location_Type); - - -- Disp a message during elaboration (or configuration). - procedure Error_Msg_Elab (Msg: String); - procedure Error_Msg_Elab (Msg: String; Loc: Iir); - - -- Disp a warning durig elaboration (or configuration). - procedure Warning_Msg_Elab (Msg: String; Loc : Iir); - - -- Disp a bug message. - procedure Error_Internal (Expr: Iir; Msg: String := ""); - pragma No_Return (Error_Internal); - - -- Disp a node. - -- Used for output of message. - function Disp_Node (Node: Iir) return String; - - -- Disp a node location. - -- Used for output of message. - function Disp_Location (Node: Iir) return String; - function Get_Location_Str (Loc : Location_Type; Filename : Boolean := True) - return String; - - -- Disp non-terminal name from KIND. - function Disp_Name (Kind : Iir_Kind) return String; - - -- SUBPRG must be a subprogram declaration or an enumeration literal - -- declaration. - -- Returns: - -- "enumeration literal XX [ return TYPE ]" - -- "function XXX [ TYPE1, TYPE2 return TYPE ]" - -- "procedure XXX [ TYPE1, TYPE2 ]" - -- "implicit function XXX [ TYPE1, TYPE2 return TYPE ]" - -- "implicit procedure XXX [ TYPE1, TYPE2 ]" - function Disp_Subprg (Subprg : Iir) return String; - - -- Print element POS of discrete type DTYPE. - function Disp_Discrete (Dtype : Iir; Pos : Iir_Int64) return String; - - -- Disp the name of the type of NODE if known. - -- Disp "unknown" if it is not known. - -- Disp all possible types if it is an overload list. - function Disp_Type_Of (Node : Iir) return String; - - -- Disp an error message when a pure function CALLER calls impure CALLEE. - procedure Error_Pure (Caller : Iir; Callee : Iir; Loc : Iir); - - -- Report an error message as type of EXPR does not match A_TYPE. - -- Location is LOC. - procedure Error_Not_Match (Expr: Iir; A_Type: Iir; Loc : Iir); - - -- Disp interface mode MODE. - function Get_Mode_Name (Mode : Iir_Mode) return String; -end Errorout; diff --git a/evaluation.adb b/evaluation.adb deleted file mode 100644 index 8279e140c..000000000 --- a/evaluation.adb +++ /dev/null @@ -1,3047 +0,0 @@ --- Evaluation of static expressions. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Ada.Unchecked_Deallocation; -with Errorout; use Errorout; -with Name_Table; use Name_Table; -with Str_Table; -with Iirs_Utils; use Iirs_Utils; -with Std_Package; use Std_Package; -with Flags; use Flags; -with Std_Names; -with Ada.Characters.Handling; - -package body Evaluation is - function Get_Physical_Value (Expr : Iir) return Iir_Int64 - is - pragma Unsuppress (Overflow_Check); - Kind : constant Iir_Kind := Get_Kind (Expr); - Unit : Iir; - begin - case Kind is - when Iir_Kind_Physical_Int_Literal - | Iir_Kind_Physical_Fp_Literal => - -- Extract Unit. - Unit := Get_Physical_Unit_Value - (Get_Named_Entity (Get_Unit_Name (Expr))); - case Kind is - when Iir_Kind_Physical_Int_Literal => - return Get_Value (Expr) * Get_Value (Unit); - when Iir_Kind_Physical_Fp_Literal => - return Iir_Int64 - (Get_Fp_Value (Expr) * Iir_Fp64 (Get_Value (Unit))); - when others => - raise Program_Error; - end case; - when Iir_Kind_Unit_Declaration => - return Get_Value (Get_Physical_Unit_Value (Expr)); - when others => - Error_Kind ("get_physical_value", Expr); - end case; - exception - when Constraint_Error => - Error_Msg_Sem ("arithmetic overflow in physical expression", Expr); - return Get_Value (Expr); - end Get_Physical_Value; - - function Build_Integer (Val : Iir_Int64; Origin : Iir) - return Iir_Integer_Literal - is - Res : Iir_Integer_Literal; - begin - Res := Create_Iir (Iir_Kind_Integer_Literal); - Location_Copy (Res, Origin); - Set_Value (Res, Val); - Set_Type (Res, Get_Type (Origin)); - Set_Literal_Origin (Res, Origin); - Set_Expr_Staticness (Res, Locally); - return Res; - end Build_Integer; - - function Build_Floating (Val : Iir_Fp64; Origin : Iir) - return Iir_Floating_Point_Literal - is - Res : Iir_Floating_Point_Literal; - begin - Res := Create_Iir (Iir_Kind_Floating_Point_Literal); - Location_Copy (Res, Origin); - Set_Fp_Value (Res, Val); - Set_Type (Res, Get_Type (Origin)); - Set_Literal_Origin (Res, Origin); - Set_Expr_Staticness (Res, Locally); - return Res; - end Build_Floating; - - function Build_Enumeration_Constant (Val : Iir_Index32; Origin : Iir) - return Iir_Enumeration_Literal - is - Enum_Type : constant Iir := Get_Base_Type (Get_Type (Origin)); - Enum_List : constant Iir_List := - Get_Enumeration_Literal_List (Enum_Type); - Lit : constant Iir_Enumeration_Literal := - Get_Nth_Element (Enum_List, Integer (Val)); - Res : Iir_Enumeration_Literal; - begin - Res := Copy_Enumeration_Literal (Lit); - Location_Copy (Res, Origin); - Set_Literal_Origin (Res, Origin); - return Res; - end Build_Enumeration_Constant; - - function Build_Physical (Val : Iir_Int64; Origin : Iir) - return Iir_Physical_Int_Literal - is - Res : Iir_Physical_Int_Literal; - Unit_Name : Iir; - begin - Res := Create_Iir (Iir_Kind_Physical_Int_Literal); - Location_Copy (Res, Origin); - Unit_Name := Get_Primary_Unit_Name (Get_Base_Type (Get_Type (Origin))); - Set_Unit_Name (Res, Unit_Name); - Set_Value (Res, Val); - Set_Type (Res, Get_Type (Origin)); - Set_Literal_Origin (Res, Origin); - Set_Expr_Staticness (Res, Locally); - return Res; - end Build_Physical; - - function Build_Discrete (Val : Iir_Int64; Origin : Iir) return Iir is - begin - case Get_Kind (Get_Type (Origin)) is - when Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Enumeration_Subtype_Definition => - return Build_Enumeration_Constant (Iir_Index32 (Val), Origin); - when Iir_Kind_Integer_Type_Definition - | Iir_Kind_Integer_Subtype_Definition => - return Build_Integer (Val, Origin); - when others => - Error_Kind ("build_discrete", Get_Type (Origin)); - end case; - end Build_Discrete; - - function Build_String (Val : String_Id; Len : Nat32; Origin : Iir) - return Iir_String_Literal - is - Res : Iir_String_Literal; - begin - Res := Create_Iir (Iir_Kind_String_Literal); - Location_Copy (Res, Origin); - Set_String_Id (Res, Val); - Set_String_Length (Res, Len); - Set_Type (Res, Get_Type (Origin)); - Set_Literal_Origin (Res, Origin); - Set_Expr_Staticness (Res, Locally); - return Res; - end Build_String; - - function Build_Simple_Aggregate - (El_List : Iir_List; Origin : Iir; Stype : Iir) - return Iir_Simple_Aggregate - is - Res : Iir_Simple_Aggregate; - begin - Res := Create_Iir (Iir_Kind_Simple_Aggregate); - Location_Copy (Res, Origin); - Set_Simple_Aggregate_List (Res, El_List); - Set_Type (Res, Stype); - Set_Literal_Origin (Res, Origin); - Set_Expr_Staticness (Res, Locally); - Set_Literal_Subtype (Res, Stype); - return Res; - end Build_Simple_Aggregate; - - function Build_Overflow (Origin : Iir) return Iir - is - Res : Iir; - begin - Res := Create_Iir (Iir_Kind_Overflow_Literal); - Location_Copy (Res, Origin); - Set_Type (Res, Get_Type (Origin)); - Set_Literal_Origin (Res, Origin); - Set_Expr_Staticness (Res, Locally); - return Res; - end Build_Overflow; - - function Build_Constant (Val : Iir; Origin : Iir) return Iir - is - Res : Iir; - begin - -- Note: this must work for any literals, because it may be used to - -- replace a locally static constant by its initial value. - case Get_Kind (Val) is - when Iir_Kind_Integer_Literal => - Res := Create_Iir (Iir_Kind_Integer_Literal); - Set_Value (Res, Get_Value (Val)); - - when Iir_Kind_Floating_Point_Literal => - Res := Create_Iir (Iir_Kind_Floating_Point_Literal); - Set_Fp_Value (Res, Get_Fp_Value (Val)); - - when Iir_Kind_Enumeration_Literal => - return Build_Enumeration_Constant - (Iir_Index32 (Get_Enum_Pos (Val)), Origin); - - when Iir_Kind_Physical_Int_Literal => - Res := Create_Iir (Iir_Kind_Physical_Int_Literal); - Set_Unit_Name (Res, Get_Primary_Unit_Name - (Get_Base_Type (Get_Type (Origin)))); - Set_Value (Res, Get_Physical_Value (Val)); - - when Iir_Kind_Unit_Declaration => - Res := Create_Iir (Iir_Kind_Physical_Int_Literal); - Set_Value (Res, Get_Physical_Value (Val)); - Set_Unit_Name (Res, Get_Primary_Unit_Name (Get_Type (Val))); - - when Iir_Kind_String_Literal => - Res := Create_Iir (Iir_Kind_String_Literal); - Set_String_Id (Res, Get_String_Id (Val)); - Set_String_Length (Res, Get_String_Length (Val)); - - when Iir_Kind_Bit_String_Literal => - Res := Create_Iir (Iir_Kind_Bit_String_Literal); - Set_String_Id (Res, Get_String_Id (Val)); - Set_String_Length (Res, Get_String_Length (Val)); - Set_Bit_String_Base (Res, Get_Bit_String_Base (Val)); - Set_Bit_String_0 (Res, Get_Bit_String_0 (Val)); - Set_Bit_String_1 (Res, Get_Bit_String_1 (Val)); - - when Iir_Kind_Simple_Aggregate => - Res := Create_Iir (Iir_Kind_Simple_Aggregate); - Set_Simple_Aggregate_List (Res, Get_Simple_Aggregate_List (Val)); - Set_Literal_Subtype (Res, Get_Type (Origin)); - - when Iir_Kind_Overflow_Literal => - Res := Create_Iir (Iir_Kind_Overflow_Literal); - - when others => - Error_Kind ("build_constant", Val); - end case; - Location_Copy (Res, Origin); - Set_Type (Res, Get_Type (Origin)); - Set_Literal_Origin (Res, Origin); - Set_Expr_Staticness (Res, Locally); - return Res; - end Build_Constant; - - function Build_Boolean (Cond : Boolean) return Iir is - begin - if Cond then - return Boolean_True; - else - return Boolean_False; - end if; - end Build_Boolean; - - function Build_Enumeration (Val : Iir_Index32; Origin : Iir) - return Iir_Enumeration_Literal - is - Enum_Type : constant Iir := Get_Base_Type (Get_Type (Origin)); - Enum_List : constant Iir_List := - Get_Enumeration_Literal_List (Enum_Type); - begin - return Get_Nth_Element (Enum_List, Integer (Val)); - end Build_Enumeration; - - function Build_Enumeration (Val : Boolean; Origin : Iir) - return Iir_Enumeration_Literal - is - Enum_Type : constant Iir := Get_Base_Type (Get_Type (Origin)); - Enum_List : constant Iir_List := - Get_Enumeration_Literal_List (Enum_Type); - begin - return Get_Nth_Element (Enum_List, Boolean'Pos (Val)); - end Build_Enumeration; - - function Build_Constant_Range (Range_Expr : Iir; Origin : Iir) return Iir - is - Res : Iir; - begin - Res := Create_Iir (Iir_Kind_Range_Expression); - Location_Copy (Res, Origin); - Set_Type (Res, Get_Type (Range_Expr)); - Set_Left_Limit (Res, Get_Left_Limit (Range_Expr)); - Set_Right_Limit (Res, Get_Right_Limit (Range_Expr)); - Set_Direction (Res, Get_Direction (Range_Expr)); - Set_Range_Origin (Res, Origin); - Set_Expr_Staticness (Res, Locally); - return Res; - end Build_Constant_Range; - - function Build_Extreme_Value (Is_Pos : Boolean; Origin : Iir) return Iir - is - Orig_Type : constant Iir := Get_Base_Type (Get_Type (Origin)); - begin - case Get_Kind (Orig_Type) is - when Iir_Kind_Integer_Type_Definition => - if Is_Pos then - return Build_Integer (Iir_Int64'Last, Origin); - else - return Build_Integer (Iir_Int64'First, Origin); - end if; - when others => - Error_Kind ("build_extreme_value", Orig_Type); - end case; - end Build_Extreme_Value; - - -- A_RANGE is a range expression, whose type, location, expr_staticness, - -- left_limit and direction are set. - -- Type of A_RANGE must have a range_constraint. - -- Set the right limit of A_RANGE from LEN. - procedure Set_Right_Limit_By_Length (A_Range : Iir; Len : Iir_Int64) - is - Left, Right : Iir; - Pos : Iir_Int64; - A_Type : Iir; - begin - if Get_Expr_Staticness (A_Range) /= Locally then - raise Internal_Error; - end if; - A_Type := Get_Type (A_Range); - - Left := Get_Left_Limit (A_Range); - - Pos := Eval_Pos (Left); - case Get_Direction (A_Range) is - when Iir_To => - Pos := Pos + Len -1; - when Iir_Downto => - Pos := Pos - Len + 1; - end case; - if Len > 0 - and then not Eval_Int_In_Range (Pos, Get_Range_Constraint (A_Type)) - then - Error_Msg_Sem ("range length is beyond subtype length", A_Range); - Right := Left; - else - -- FIXME: what about nul range? - Right := Build_Discrete (Pos, A_Range); - Set_Literal_Origin (Right, Null_Iir); - end if; - Set_Right_Limit (A_Range, Right); - end Set_Right_Limit_By_Length; - - -- Create a range of type A_TYPE whose length is LEN. - -- Note: only two nodes are created: - -- * the range_expression (node returned) - -- * the right bound - -- The left bound *IS NOT* created, but points to the left bound of A_TYPE. - function Create_Range_By_Length - (A_Type : Iir; Len : Iir_Int64; Loc : Location_Type) - return Iir - is - Index_Constraint : Iir; - Constraint : Iir; - begin - -- The left limit must be locally static in order to compute the right - -- limit. - pragma Assert (Get_Type_Staticness (A_Type) = Locally); - - Index_Constraint := Get_Range_Constraint (A_Type); - Constraint := Create_Iir (Iir_Kind_Range_Expression); - Set_Location (Constraint, Loc); - Set_Expr_Staticness (Constraint, Locally); - Set_Type (Constraint, A_Type); - Set_Left_Limit (Constraint, Get_Left_Limit (Index_Constraint)); - Set_Direction (Constraint, Get_Direction (Index_Constraint)); - Set_Right_Limit_By_Length (Constraint, Len); - return Constraint; - end Create_Range_By_Length; - - function Create_Range_Subtype_From_Type (A_Type : Iir; Loc : Location_Type) - return Iir - is - Res : Iir; - begin - pragma Assert (Get_Type_Staticness (A_Type) = Locally); - - case Get_Kind (A_Type) is - when Iir_Kind_Enumeration_Type_Definition => - Res := Create_Iir (Iir_Kind_Enumeration_Subtype_Definition); - when Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition => - Res := Create_Iir (Get_Kind (A_Type)); - when others => - Error_Kind ("create_range_subtype_by_length", A_Type); - end case; - Set_Location (Res, Loc); - Set_Base_Type (Res, Get_Base_Type (A_Type)); - Set_Type_Staticness (Res, Locally); - - return Res; - end Create_Range_Subtype_From_Type; - - -- Create a subtype of A_TYPE whose length is LEN. - -- This is used to create subtypes for strings or aggregates. - function Create_Range_Subtype_By_Length - (A_Type : Iir; Len : Iir_Int64; Loc : Location_Type) - return Iir - is - Res : Iir; - begin - Res := Create_Range_Subtype_From_Type (A_Type, Loc); - - Set_Range_Constraint (Res, Create_Range_By_Length (A_Type, Len, Loc)); - return Res; - end Create_Range_Subtype_By_Length; - - function Create_Unidim_Array_From_Index - (Base_Type : Iir; Index_Type : Iir; Loc : Iir) - return Iir_Array_Subtype_Definition - is - Res : Iir_Array_Subtype_Definition; - begin - Res := Create_Array_Subtype (Base_Type, Get_Location (Loc)); - Append_Element (Get_Index_Subtype_List (Res), Index_Type); - Set_Type_Staticness (Res, Min (Get_Type_Staticness (Res), - Get_Type_Staticness (Index_Type))); - Set_Constraint_State (Res, Fully_Constrained); - Set_Index_Constraint_Flag (Res, True); - return Res; - end Create_Unidim_Array_From_Index; - - function Create_Unidim_Array_By_Length - (Base_Type : Iir; Len : Iir_Int64; Loc : Iir) - return Iir_Array_Subtype_Definition - is - Index_Type : constant Iir := Get_Index_Type (Base_Type, 0); - N_Index_Type : Iir; - begin - N_Index_Type := Create_Range_Subtype_By_Length - (Index_Type, Len, Get_Location (Loc)); - return Create_Unidim_Array_From_Index (Base_Type, N_Index_Type, Loc); - end Create_Unidim_Array_By_Length; - - procedure Free_Eval_Static_Expr (Res : Iir; Orig : Iir) is - begin - if Res /= Orig and then Get_Literal_Origin (Res) = Orig then - Free_Iir (Res); - end if; - end Free_Eval_Static_Expr; - - -- Free the result RES of Eval_String_Literal called with ORIG, if created. - procedure Free_Eval_String_Literal (Res : Iir; Orig : Iir) - is - L : Iir_List; - begin - if Res /= Orig then - L := Get_Simple_Aggregate_List (Res); - Destroy_Iir_List (L); - Free_Iir (Res); - end if; - end Free_Eval_String_Literal; - - function Eval_String_Literal (Str : Iir) return Iir - is - Ptr : String_Fat_Acc; - Len : Nat32; - begin - case Get_Kind (Str) is - when Iir_Kind_String_Literal => - declare - Element_Type : Iir; - Literal_List : Iir_List; - Lit : Iir; - - List : Iir_List; - begin - Element_Type := Get_Base_Type - (Get_Element_Subtype (Get_Base_Type (Get_Type (Str)))); - Literal_List := Get_Enumeration_Literal_List (Element_Type); - List := Create_Iir_List; - - Ptr := Get_String_Fat_Acc (Str); - Len := Get_String_Length (Str); - - for I in 1 .. Len loop - Lit := Find_Name_In_List - (Literal_List, - Name_Table.Get_Identifier (Ptr (I))); - Append_Element (List, Lit); - end loop; - return Build_Simple_Aggregate (List, Str, Get_Type (Str)); - end; - - when Iir_Kind_Bit_String_Literal => - declare - Str_Type : constant Iir := Get_Type (Str); - List : Iir_List; - Lit_0 : constant Iir := Get_Bit_String_0 (Str); - Lit_1 : constant Iir := Get_Bit_String_1 (Str); - begin - List := Create_Iir_List; - - Ptr := Get_String_Fat_Acc (Str); - Len := Get_String_Length (Str); - - for I in 1 .. Len loop - case Ptr (I) is - when '0' => - Append_Element (List, Lit_0); - when '1' => - Append_Element (List, Lit_1); - when others => - raise Internal_Error; - end case; - end loop; - return Build_Simple_Aggregate (List, Str, Str_Type); - end; - - when Iir_Kind_Simple_Aggregate => - return Str; - - when others => - Error_Kind ("eval_string_literal", Str); - end case; - end Eval_String_Literal; - - function Eval_Monadic_Operator (Orig : Iir; Operand : Iir) return Iir - is - pragma Unsuppress (Overflow_Check); - - Func : Iir_Predefined_Functions; - begin - if Get_Kind (Operand) = Iir_Kind_Overflow_Literal then - -- Propagate overflow. - return Build_Overflow (Orig); - end if; - - Func := Get_Implicit_Definition (Get_Implementation (Orig)); - case Func is - when Iir_Predefined_Integer_Negation => - return Build_Integer (-Get_Value (Operand), Orig); - when Iir_Predefined_Integer_Identity => - return Build_Integer (Get_Value (Operand), Orig); - when Iir_Predefined_Integer_Absolute => - return Build_Integer (abs Get_Value (Operand), Orig); - - when Iir_Predefined_Floating_Negation => - return Build_Floating (-Get_Fp_Value (Operand), Orig); - when Iir_Predefined_Floating_Identity => - return Build_Floating (Get_Fp_Value (Operand), Orig); - when Iir_Predefined_Floating_Absolute => - return Build_Floating (abs Get_Fp_Value (Operand), Orig); - - when Iir_Predefined_Physical_Negation => - return Build_Physical (-Get_Physical_Value (Operand), Orig); - when Iir_Predefined_Physical_Identity => - return Build_Physical (Get_Physical_Value (Operand), Orig); - when Iir_Predefined_Physical_Absolute => - return Build_Physical (abs Get_Physical_Value (Operand), Orig); - - when Iir_Predefined_Boolean_Not - | Iir_Predefined_Bit_Not => - return Build_Enumeration (Get_Enum_Pos (Operand) = 0, Orig); - - when Iir_Predefined_TF_Array_Not => - declare - O_List : Iir_List; - R_List : Iir_List; - El : Iir; - Lit : Iir; - begin - O_List := Get_Simple_Aggregate_List - (Eval_String_Literal (Operand)); - R_List := Create_Iir_List; - - for I in Natural loop - El := Get_Nth_Element (O_List, I); - exit when El = Null_Iir; - case Get_Enum_Pos (El) is - when 0 => - Lit := Bit_1; - when 1 => - Lit := Bit_0; - when others => - raise Internal_Error; - end case; - Append_Element (R_List, Lit); - end loop; - return Build_Simple_Aggregate - (R_List, Orig, Get_Type (Operand)); - end; - when others => - Error_Internal (Orig, "eval_monadic_operator: " & - Iir_Predefined_Functions'Image (Func)); - end case; - exception - when Constraint_Error => - -- Can happen for absolute. - Warning_Msg_Sem ("arithmetic overflow in static expression", Orig); - return Build_Overflow (Orig); - end Eval_Monadic_Operator; - - function Eval_Dyadic_Bit_Array_Operator - (Expr : Iir; - Left, Right : Iir; - Func : Iir_Predefined_Dyadic_TF_Array_Functions) - return Iir - is - use Str_Table; - L_Str : constant String_Fat_Acc := Get_String_Fat_Acc (Left); - R_Str : constant String_Fat_Acc := Get_String_Fat_Acc (Right); - Len : Nat32; - Id : String_Id; - Res : Iir; - begin - Len := Get_String_Length (Left); - if Len /= Get_String_Length (Right) then - Warning_Msg_Sem ("length of left and right operands mismatch", Expr); - return Build_Overflow (Expr); - else - Id := Start; - case Func is - when Iir_Predefined_TF_Array_And => - for I in 1 .. Len loop - case L_Str (I) is - when '0' => - Append ('0'); - when '1' => - Append (R_Str (I)); - when others => - raise Internal_Error; - end case; - end loop; - when Iir_Predefined_TF_Array_Nand => - for I in 1 .. Len loop - case L_Str (I) is - when '0' => - Append ('1'); - when '1' => - case R_Str (I) is - when '0' => - Append ('1'); - when '1' => - Append ('0'); - when others => - raise Internal_Error; - end case; - when others => - raise Internal_Error; - end case; - end loop; - when Iir_Predefined_TF_Array_Or => - for I in 1 .. Len loop - case L_Str (I) is - when '1' => - Append ('1'); - when '0' => - Append (R_Str (I)); - when others => - raise Internal_Error; - end case; - end loop; - when Iir_Predefined_TF_Array_Nor => - for I in 1 .. Len loop - case L_Str (I) is - when '1' => - Append ('0'); - when '0' => - case R_Str (I) is - when '0' => - Append ('1'); - when '1' => - Append ('0'); - when others => - raise Internal_Error; - end case; - when others => - raise Internal_Error; - end case; - end loop; - when Iir_Predefined_TF_Array_Xor => - for I in 1 .. Len loop - case L_Str (I) is - when '1' => - case R_Str (I) is - when '0' => - Append ('1'); - when '1' => - Append ('0'); - when others => - raise Internal_Error; - end case; - when '0' => - case R_Str (I) is - when '0' => - Append ('0'); - when '1' => - Append ('1'); - when others => - raise Internal_Error; - end case; - when others => - raise Internal_Error; - end case; - end loop; - when others => - Error_Internal (Expr, "eval_dyadic_bit_array_functions: " & - Iir_Predefined_Functions'Image (Func)); - end case; - Finish; - Res := Build_String (Id, Len, Expr); - - -- The unconstrained type is replaced by the constrained one. - Set_Type (Res, Get_Type (Left)); - return Res; - end if; - end Eval_Dyadic_Bit_Array_Operator; - - -- Return TRUE if VAL /= 0. - function Check_Integer_Division_By_Zero (Expr : Iir; Val : Iir) - return Boolean - is - begin - if Get_Value (Val) = 0 then - Warning_Msg_Sem ("division by 0", Expr); - return False; - else - return True; - end if; - end Check_Integer_Division_By_Zero; - - function Eval_Shift_Operator - (Left, Right : Iir; Origin : Iir; Func : Iir_Predefined_Shift_Functions) - return Iir - is - Count : Iir_Int64; - Cnt : Natural; - Len : Natural; - Arr_List : Iir_List; - Res_List : Iir_List; - Dir_Left : Boolean; - E : Iir; - begin - Count := Get_Value (Right); - Arr_List := Get_Simple_Aggregate_List (Left); - Len := Get_Nbr_Elements (Arr_List); - -- LRM93 7.2.3 - -- That is, if R is 0 or if L is a null array, the return value is L. - if Count = 0 or Len = 0 then - return Build_Simple_Aggregate (Arr_List, Origin, Get_Type (Left)); - end if; - case Func is - when Iir_Predefined_Array_Sll - | Iir_Predefined_Array_Sla - | Iir_Predefined_Array_Rol => - Dir_Left := True; - when Iir_Predefined_Array_Srl - | Iir_Predefined_Array_Sra - | Iir_Predefined_Array_Ror => - Dir_Left := False; - end case; - if Count < 0 then - Cnt := Natural (-Count); - Dir_Left := not Dir_Left; - else - Cnt := Natural (Count); - end if; - - case Func is - when Iir_Predefined_Array_Sll - | Iir_Predefined_Array_Srl => - declare - Enum_List : Iir_List; - begin - Enum_List := Get_Enumeration_Literal_List - (Get_Base_Type (Get_Element_Subtype (Get_Type (Left)))); - E := Get_Nth_Element (Enum_List, 0); - end; - when Iir_Predefined_Array_Sla - | Iir_Predefined_Array_Sra => - if Dir_Left then - E := Get_Nth_Element (Arr_List, Len - 1); - else - E := Get_Nth_Element (Arr_List, 0); - end if; - when Iir_Predefined_Array_Rol - | Iir_Predefined_Array_Ror => - Cnt := Cnt mod Len; - if not Dir_Left then - Cnt := (Len - Cnt) mod Len; - end if; - end case; - - Res_List := Create_Iir_List; - - case Func is - when Iir_Predefined_Array_Sll - | Iir_Predefined_Array_Srl - | Iir_Predefined_Array_Sla - | Iir_Predefined_Array_Sra => - if Dir_Left then - if Cnt < Len then - for I in Cnt .. Len - 1 loop - Append_Element - (Res_List, Get_Nth_Element (Arr_List, I)); - end loop; - else - Cnt := Len; - end if; - for I in 0 .. Cnt - 1 loop - Append_Element (Res_List, E); - end loop; - else - if Cnt > Len then - Cnt := Len; - end if; - for I in 0 .. Cnt - 1 loop - Append_Element (Res_List, E); - end loop; - for I in Cnt .. Len - 1 loop - Append_Element - (Res_List, Get_Nth_Element (Arr_List, I - Cnt)); - end loop; - end if; - when Iir_Predefined_Array_Rol - | Iir_Predefined_Array_Ror => - for I in 1 .. Len loop - Append_Element - (Res_List, Get_Nth_Element (Arr_List, Cnt)); - Cnt := Cnt + 1; - if Cnt = Len then - Cnt := 0; - end if; - end loop; - end case; - return Build_Simple_Aggregate (Res_List, Origin, Get_Type (Left)); - end Eval_Shift_Operator; - - -- Note: operands must be locally static. - function Eval_Concatenation - (Left, Right : Iir; Orig : Iir; Func : Iir_Predefined_Concat_Functions) - return Iir - is - Res_List : Iir_List; - L : Natural; - Res_Type : Iir; - Origin_Type : Iir; - Left_Aggr, Right_Aggr : Iir; - Left_List, Right_List : Iir_List; - Left_Len : Natural; - begin - Res_List := Create_Iir_List; - -- Do the concatenation. - -- Left: - case Func is - when Iir_Predefined_Element_Array_Concat - | Iir_Predefined_Element_Element_Concat => - Append_Element (Res_List, Left); - Left_Len := 1; - when Iir_Predefined_Array_Element_Concat - | Iir_Predefined_Array_Array_Concat => - Left_Aggr := Eval_String_Literal (Left); - Left_List := Get_Simple_Aggregate_List (Left_Aggr); - Left_Len := Get_Nbr_Elements (Left_List); - for I in 0 .. Left_Len - 1 loop - Append_Element (Res_List, Get_Nth_Element (Left_List, I)); - end loop; - Free_Eval_String_Literal (Left_Aggr, Left); - end case; - -- Right: - case Func is - when Iir_Predefined_Array_Element_Concat - | Iir_Predefined_Element_Element_Concat => - Append_Element (Res_List, Right); - when Iir_Predefined_Element_Array_Concat - | Iir_Predefined_Array_Array_Concat => - Right_Aggr := Eval_String_Literal (Right); - Right_List := Get_Simple_Aggregate_List (Right_Aggr); - L := Get_Nbr_Elements (Right_List); - for I in 0 .. L - 1 loop - Append_Element (Res_List, Get_Nth_Element (Right_List, I)); - end loop; - Free_Eval_String_Literal (Right_Aggr, Right); - end case; - L := Get_Nbr_Elements (Res_List); - - -- Compute subtype... - Origin_Type := Get_Type (Orig); - Res_Type := Null_Iir; - if Func = Iir_Predefined_Array_Array_Concat - and then Left_Len = 0 - then - if Flags.Vhdl_Std = Vhdl_87 then - -- LRM87 7.2.4 - -- [...], unless the left operand is a null array, in which case - -- the result of the concatenation is the right operand. - Res_Type := Get_Type (Right); - else - -- LRM93 7.2.4 - -- If both operands are null arrays, then the result of the - -- concatenation is the right operand. - if Get_Nbr_Elements (Right_List) = 0 then - Res_Type := Get_Type (Right); - end if; - end if; - end if; - if Res_Type = Null_Iir then - if Flags.Vhdl_Std = Vhdl_87 - and then (Func = Iir_Predefined_Array_Array_Concat - or Func = Iir_Predefined_Array_Element_Concat) - then - -- LRM87 7.2.4 - -- The left bound of the result is the left operand, [...] - -- - -- LRM87 7.2.4 - -- The direction of the result is the direction of the left - -- operand, [...] - declare - Left_Index : constant Iir := - Get_Index_Type (Get_Type (Left), 0); - Left_Range : constant Iir := - Get_Range_Constraint (Left_Index); - Ret_Type : constant Iir := - Get_Return_Type (Get_Implementation (Orig)); - A_Range : Iir; - Index_Type : Iir; - begin - A_Range := Create_Iir (Iir_Kind_Range_Expression); - Set_Type (A_Range, Get_Index_Type (Ret_Type, 0)); - Set_Expr_Staticness (A_Range, Locally); - Set_Left_Limit (A_Range, Get_Left_Limit (Left_Range)); - Set_Direction (A_Range, Get_Direction (Left_Range)); - Location_Copy (A_Range, Orig); - Set_Right_Limit_By_Length (A_Range, Iir_Int64 (L)); - Index_Type := Create_Range_Subtype_From_Type - (Left_Index, Get_Location (Orig)); - Set_Range_Constraint (Index_Type, A_Range); - Res_Type := Create_Unidim_Array_From_Index - (Origin_Type, Index_Type, Orig); - end; - else - -- LRM93 7.2.4 - -- Otherwise, the direction and bounds of the result are - -- determined as follows: let S be the index subtype of the base - -- type of the result. The direction of the result of the - -- concatenation is the direction of S, and the left bound of the - -- result is S'LEFT. - Res_Type := Create_Unidim_Array_By_Length - (Origin_Type, Iir_Int64 (L), Orig); - end if; - end if; - -- FIXME: this is not necessarily a string, it may be an aggregate if - -- element type is not a character type. - return Build_Simple_Aggregate (Res_List, Orig, Res_Type); - end Eval_Concatenation; - - function Eval_Array_Equality (Left, Right : Iir) return Boolean - is - Left_Val, Right_Val : Iir; - L_List : Iir_List; - R_List : Iir_List; - N : Natural; - Res : Boolean; - begin - Left_Val := Eval_String_Literal (Left); - Right_Val := Eval_String_Literal (Right); - - L_List := Get_Simple_Aggregate_List (Left_Val); - R_List := Get_Simple_Aggregate_List (Right_Val); - N := Get_Nbr_Elements (L_List); - if N /= Get_Nbr_Elements (R_List) then - -- Cannot be equal if not the same length. - Res := False; - else - Res := True; - for I in 0 .. N - 1 loop - -- FIXME: this is wrong: (eg: evaluated lit) - if Get_Nth_Element (L_List, I) /= Get_Nth_Element (R_List, I) then - Res := False; - exit; - end if; - end loop; - end if; - - Free_Eval_Static_Expr (Left_Val, Left); - Free_Eval_Static_Expr (Right_Val, Right); - - return Res; - end Eval_Array_Equality; - - -- ORIG is either a dyadic operator or a function call. - function Eval_Dyadic_Operator (Orig : Iir; Imp : Iir; Left, Right : Iir) - return Iir - is - pragma Unsuppress (Overflow_Check); - Func : constant Iir_Predefined_Functions := - Get_Implicit_Definition (Imp); - begin - if Get_Kind (Left) = Iir_Kind_Overflow_Literal - or else Get_Kind (Right) = Iir_Kind_Overflow_Literal - then - return Build_Overflow (Orig); - end if; - - case Func is - when Iir_Predefined_Integer_Plus => - return Build_Integer (Get_Value (Left) + Get_Value (Right), Orig); - when Iir_Predefined_Integer_Minus => - return Build_Integer (Get_Value (Left) - Get_Value (Right), Orig); - when Iir_Predefined_Integer_Mul => - return Build_Integer (Get_Value (Left) * Get_Value (Right), Orig); - when Iir_Predefined_Integer_Div => - if Check_Integer_Division_By_Zero (Orig, Right) then - return Build_Integer - (Get_Value (Left) / Get_Value (Right), Orig); - else - return Build_Overflow (Orig); - end if; - when Iir_Predefined_Integer_Mod => - if Check_Integer_Division_By_Zero (Orig, Right) then - return Build_Integer - (Get_Value (Left) mod Get_Value (Right), Orig); - else - return Build_Overflow (Orig); - end if; - when Iir_Predefined_Integer_Rem => - if Check_Integer_Division_By_Zero (Orig, Right) then - return Build_Integer - (Get_Value (Left) rem Get_Value (Right), Orig); - else - return Build_Overflow (Orig); - end if; - when Iir_Predefined_Integer_Exp => - return Build_Integer - (Get_Value (Left) ** Integer (Get_Value (Right)), Orig); - - when Iir_Predefined_Integer_Equality => - return Build_Boolean (Get_Value (Left) = Get_Value (Right)); - when Iir_Predefined_Integer_Inequality => - return Build_Boolean (Get_Value (Left) /= Get_Value (Right)); - when Iir_Predefined_Integer_Greater_Equal => - return Build_Boolean (Get_Value (Left) >= Get_Value (Right)); - when Iir_Predefined_Integer_Greater => - return Build_Boolean (Get_Value (Left) > Get_Value (Right)); - when Iir_Predefined_Integer_Less_Equal => - return Build_Boolean (Get_Value (Left) <= Get_Value (Right)); - when Iir_Predefined_Integer_Less => - return Build_Boolean (Get_Value (Left) < Get_Value (Right)); - - when Iir_Predefined_Integer_Minimum => - if Get_Value (Left) < Get_Value (Right) then - return Left; - else - return Right; - end if; - when Iir_Predefined_Integer_Maximum => - if Get_Value (Left) > Get_Value (Right) then - return Left; - else - return Right; - end if; - - when Iir_Predefined_Floating_Equality => - return Build_Boolean (Get_Fp_Value (Left) = Get_Fp_Value (Right)); - when Iir_Predefined_Floating_Inequality => - return Build_Boolean (Get_Fp_Value (Left) /= Get_Fp_Value (Right)); - when Iir_Predefined_Floating_Greater => - return Build_Boolean (Get_Fp_Value (Left) > Get_Fp_Value (Right)); - when Iir_Predefined_Floating_Greater_Equal => - return Build_Boolean (Get_Fp_Value (Left) >= Get_Fp_Value (Right)); - when Iir_Predefined_Floating_Less => - return Build_Boolean (Get_Fp_Value (Left) < Get_Fp_Value (Right)); - when Iir_Predefined_Floating_Less_Equal => - return Build_Boolean (Get_Fp_Value (Left) <= Get_Fp_Value (Right)); - - when Iir_Predefined_Floating_Minus => - return Build_Floating - (Get_Fp_Value (Left) - Get_Fp_Value (Right), Orig); - when Iir_Predefined_Floating_Plus => - return Build_Floating - (Get_Fp_Value (Left) + Get_Fp_Value (Right), Orig); - when Iir_Predefined_Floating_Mul => - return Build_Floating - (Get_Fp_Value (Left) * Get_Fp_Value (Right), Orig); - when Iir_Predefined_Floating_Div => - if Get_Fp_Value (Right) = 0.0 then - Warning_Msg_Sem ("right operand of division is 0", Orig); - return Build_Overflow (Orig); - else - return Build_Floating - (Get_Fp_Value (Left) / Get_Fp_Value (Right), Orig); - end if; - when Iir_Predefined_Floating_Exp => - declare - Exp : Iir_Int64; - Res : Iir_Fp64; - Val : Iir_Fp64; - begin - Res := 1.0; - Val := Get_Fp_Value (Left); - Exp := abs Get_Value (Right); - while Exp /= 0 loop - if Exp mod 2 = 1 then - Res := Res * Val; - end if; - Exp := Exp / 2; - Val := Val * Val; - end loop; - if Get_Value (Right) < 0 then - Res := 1.0 / Res; - end if; - return Build_Floating (Res, Orig); - end; - - when Iir_Predefined_Floating_Minimum => - if Get_Fp_Value (Left) < Get_Fp_Value (Right) then - return Left; - else - return Right; - end if; - when Iir_Predefined_Floating_Maximum => - if Get_Fp_Value (Left) > Get_Fp_Value (Right) then - return Left; - else - return Right; - end if; - - when Iir_Predefined_Physical_Equality => - return Build_Boolean - (Get_Physical_Value (Left) = Get_Physical_Value (Right)); - when Iir_Predefined_Physical_Inequality => - return Build_Boolean - (Get_Physical_Value (Left) /= Get_Physical_Value (Right)); - when Iir_Predefined_Physical_Greater_Equal => - return Build_Boolean - (Get_Physical_Value (Left) >= Get_Physical_Value (Right)); - when Iir_Predefined_Physical_Greater => - return Build_Boolean - (Get_Physical_Value (Left) > Get_Physical_Value (Right)); - when Iir_Predefined_Physical_Less_Equal => - return Build_Boolean - (Get_Physical_Value (Left) <= Get_Physical_Value (Right)); - when Iir_Predefined_Physical_Less => - return Build_Boolean - (Get_Physical_Value (Left) < Get_Physical_Value (Right)); - - when Iir_Predefined_Physical_Physical_Div => - return Build_Integer - (Get_Physical_Value (Left) / Get_Physical_Value (Right), Orig); - when Iir_Predefined_Physical_Integer_Div => - return Build_Physical - (Get_Physical_Value (Left) / Get_Value (Right), Orig); - when Iir_Predefined_Physical_Minus => - return Build_Physical - (Get_Physical_Value (Left) - Get_Physical_Value (Right), Orig); - when Iir_Predefined_Physical_Plus => - return Build_Physical - (Get_Physical_Value (Left) + Get_Physical_Value (Right), Orig); - when Iir_Predefined_Integer_Physical_Mul => - return Build_Physical - (Get_Value (Left) * Get_Physical_Value (Right), Orig); - when Iir_Predefined_Physical_Integer_Mul => - return Build_Physical - (Get_Physical_Value (Left) * Get_Value (Right), Orig); - when Iir_Predefined_Real_Physical_Mul => - -- FIXME: overflow?? - return Build_Physical - (Iir_Int64 (Get_Fp_Value (Left) - * Iir_Fp64 (Get_Physical_Value (Right))), Orig); - when Iir_Predefined_Physical_Real_Mul => - -- FIXME: overflow?? - return Build_Physical - (Iir_Int64 (Iir_Fp64 (Get_Physical_Value (Left)) - * Get_Fp_Value (Right)), Orig); - when Iir_Predefined_Physical_Real_Div => - -- FIXME: overflow?? - return Build_Physical - (Iir_Int64 (Iir_Fp64 (Get_Physical_Value (Left)) - / Get_Fp_Value (Right)), Orig); - - when Iir_Predefined_Physical_Minimum => - return Build_Physical (Iir_Int64'Min (Get_Physical_Value (Left), - Get_Physical_Value (Right)), - Orig); - when Iir_Predefined_Physical_Maximum => - return Build_Physical (Iir_Int64'Max (Get_Physical_Value (Left), - Get_Physical_Value (Right)), - Orig); - - when Iir_Predefined_Element_Array_Concat - | Iir_Predefined_Array_Element_Concat - | Iir_Predefined_Array_Array_Concat - | Iir_Predefined_Element_Element_Concat => - return Eval_Concatenation (Left, Right, Orig, Func); - - when Iir_Predefined_Enum_Equality - | Iir_Predefined_Bit_Match_Equality => - return Build_Enumeration - (Get_Enum_Pos (Left) = Get_Enum_Pos (Right), Orig); - when Iir_Predefined_Enum_Inequality - | Iir_Predefined_Bit_Match_Inequality => - return Build_Enumeration - (Get_Enum_Pos (Left) /= Get_Enum_Pos (Right), Orig); - when Iir_Predefined_Enum_Greater_Equal - | Iir_Predefined_Bit_Match_Greater_Equal => - return Build_Enumeration - (Get_Enum_Pos (Left) >= Get_Enum_Pos (Right), Orig); - when Iir_Predefined_Enum_Greater - | Iir_Predefined_Bit_Match_Greater => - return Build_Enumeration - (Get_Enum_Pos (Left) > Get_Enum_Pos (Right), Orig); - when Iir_Predefined_Enum_Less_Equal - | Iir_Predefined_Bit_Match_Less_Equal => - return Build_Enumeration - (Get_Enum_Pos (Left) <= Get_Enum_Pos (Right), Orig); - when Iir_Predefined_Enum_Less - | Iir_Predefined_Bit_Match_Less => - return Build_Enumeration - (Get_Enum_Pos (Left) < Get_Enum_Pos (Right), Orig); - - when Iir_Predefined_Enum_Minimum => - if Get_Enum_Pos (Left) < Get_Enum_Pos (Right) then - return Left; - else - return Right; - end if; - when Iir_Predefined_Enum_Maximum => - if Get_Enum_Pos (Left) > Get_Enum_Pos (Right) then - return Left; - else - return Right; - end if; - - when Iir_Predefined_Boolean_And - | Iir_Predefined_Bit_And => - return Build_Enumeration - (Get_Enum_Pos (Left) = 1 and Get_Enum_Pos (Right) = 1, Orig); - when Iir_Predefined_Boolean_Nand - | Iir_Predefined_Bit_Nand => - return Build_Enumeration - (not (Get_Enum_Pos (Left) = 1 and Get_Enum_Pos (Right) = 1), - Orig); - when Iir_Predefined_Boolean_Or - | Iir_Predefined_Bit_Or => - return Build_Enumeration - (Get_Enum_Pos (Left) = 1 or Get_Enum_Pos (Right) = 1, Orig); - when Iir_Predefined_Boolean_Nor - | Iir_Predefined_Bit_Nor => - return Build_Enumeration - (not (Get_Enum_Pos (Left) = 1 or Get_Enum_Pos (Right) = 1), - Orig); - when Iir_Predefined_Boolean_Xor - | Iir_Predefined_Bit_Xor => - return Build_Enumeration - (Get_Enum_Pos (Left) = 1 xor Get_Enum_Pos (Right) = 1, Orig); - when Iir_Predefined_Boolean_Xnor - | Iir_Predefined_Bit_Xnor => - return Build_Enumeration - (not (Get_Enum_Pos (Left) = 1 xor Get_Enum_Pos (Right) = 1), - Orig); - - when Iir_Predefined_Dyadic_TF_Array_Functions => - -- FIXME: only for bit ? - return Eval_Dyadic_Bit_Array_Operator (Orig, Left, Right, Func); - - when Iir_Predefined_Universal_R_I_Mul => - return Build_Floating - (Get_Fp_Value (Left) * Iir_Fp64 (Get_Value (Right)), Orig); - when Iir_Predefined_Universal_I_R_Mul => - return Build_Floating - (Iir_Fp64 (Get_Value (Left)) * Get_Fp_Value (Right), Orig); - when Iir_Predefined_Universal_R_I_Div => - return Build_Floating - (Get_Fp_Value (Left) / Iir_Fp64 (Get_Value (Right)), Orig); - - when Iir_Predefined_Array_Equality => - return Build_Boolean (Eval_Array_Equality (Left, Right)); - - when Iir_Predefined_Array_Inequality => - return Build_Boolean (not Eval_Array_Equality (Left, Right)); - - when Iir_Predefined_Array_Sll - | Iir_Predefined_Array_Srl - | Iir_Predefined_Array_Sla - | Iir_Predefined_Array_Sra - | Iir_Predefined_Array_Rol - | Iir_Predefined_Array_Ror => - declare - Left_Aggr : Iir; - Res : Iir; - begin - Left_Aggr := Eval_String_Literal (Left); - Res := Eval_Shift_Operator (Left_Aggr, Right, Orig, Func); - Free_Eval_String_Literal (Left_Aggr, Left); - return Res; - end; - - when Iir_Predefined_Array_Less - | Iir_Predefined_Array_Less_Equal - | Iir_Predefined_Array_Greater - | Iir_Predefined_Array_Greater_Equal => - -- FIXME: todo. - Error_Internal (Orig, "eval_dyadic_operator: " & - Iir_Predefined_Functions'Image (Func)); - - when Iir_Predefined_Boolean_Not - | Iir_Predefined_Boolean_Rising_Edge - | Iir_Predefined_Boolean_Falling_Edge - | Iir_Predefined_Bit_Not - | Iir_Predefined_Bit_Rising_Edge - | Iir_Predefined_Bit_Falling_Edge - | Iir_Predefined_Integer_Absolute - | Iir_Predefined_Integer_Identity - | Iir_Predefined_Integer_Negation - | Iir_Predefined_Floating_Absolute - | Iir_Predefined_Floating_Negation - | Iir_Predefined_Floating_Identity - | Iir_Predefined_Physical_Absolute - | Iir_Predefined_Physical_Identity - | Iir_Predefined_Physical_Negation - | Iir_Predefined_Error - | Iir_Predefined_Record_Equality - | Iir_Predefined_Record_Inequality - | Iir_Predefined_Access_Equality - | Iir_Predefined_Access_Inequality - | Iir_Predefined_TF_Array_Not - | Iir_Predefined_Now_Function - | Iir_Predefined_Deallocate - | Iir_Predefined_Write - | Iir_Predefined_Read - | Iir_Predefined_Read_Length - | Iir_Predefined_Flush - | Iir_Predefined_File_Open - | Iir_Predefined_File_Open_Status - | Iir_Predefined_File_Close - | Iir_Predefined_Endfile - | Iir_Predefined_Attribute_Image - | Iir_Predefined_Attribute_Value - | Iir_Predefined_Attribute_Pos - | Iir_Predefined_Attribute_Val - | Iir_Predefined_Attribute_Succ - | Iir_Predefined_Attribute_Pred - | Iir_Predefined_Attribute_Rightof - | Iir_Predefined_Attribute_Leftof - | Iir_Predefined_Attribute_Left - | Iir_Predefined_Attribute_Right - | Iir_Predefined_Attribute_Event - | Iir_Predefined_Attribute_Active - | Iir_Predefined_Attribute_Last_Value - | Iir_Predefined_Attribute_Last_Event - | Iir_Predefined_Attribute_Last_Active - | Iir_Predefined_Attribute_Driving - | Iir_Predefined_Attribute_Driving_Value - | Iir_Predefined_Array_Char_To_String - | Iir_Predefined_Bit_Vector_To_Ostring - | Iir_Predefined_Bit_Vector_To_Hstring => - -- Not binary or never locally static. - Error_Internal (Orig, "eval_dyadic_operator: " & - Iir_Predefined_Functions'Image (Func)); - - when Iir_Predefined_Bit_Condition => - raise Internal_Error; - - when Iir_Predefined_Array_Minimum - | Iir_Predefined_Array_Maximum - | Iir_Predefined_Vector_Minimum - | Iir_Predefined_Vector_Maximum => - raise Internal_Error; - - when Iir_Predefined_Std_Ulogic_Match_Equality - | Iir_Predefined_Std_Ulogic_Match_Inequality - | Iir_Predefined_Std_Ulogic_Match_Less - | Iir_Predefined_Std_Ulogic_Match_Less_Equal - | Iir_Predefined_Std_Ulogic_Match_Greater - | Iir_Predefined_Std_Ulogic_Match_Greater_Equal => - -- TODO - raise Internal_Error; - - when Iir_Predefined_Enum_To_String - | Iir_Predefined_Integer_To_String - | Iir_Predefined_Floating_To_String - | Iir_Predefined_Real_To_String_Digits - | Iir_Predefined_Real_To_String_Format - | Iir_Predefined_Physical_To_String - | Iir_Predefined_Time_To_String_Unit => - -- TODO - raise Internal_Error; - - when Iir_Predefined_TF_Array_Element_And - | Iir_Predefined_TF_Element_Array_And - | Iir_Predefined_TF_Array_Element_Or - | Iir_Predefined_TF_Element_Array_Or - | Iir_Predefined_TF_Array_Element_Nand - | Iir_Predefined_TF_Element_Array_Nand - | Iir_Predefined_TF_Array_Element_Nor - | Iir_Predefined_TF_Element_Array_Nor - | Iir_Predefined_TF_Array_Element_Xor - | Iir_Predefined_TF_Element_Array_Xor - | Iir_Predefined_TF_Array_Element_Xnor - | Iir_Predefined_TF_Element_Array_Xnor => - -- TODO - raise Internal_Error; - - when Iir_Predefined_TF_Reduction_And - | Iir_Predefined_TF_Reduction_Or - | Iir_Predefined_TF_Reduction_Nand - | Iir_Predefined_TF_Reduction_Nor - | Iir_Predefined_TF_Reduction_Xor - | Iir_Predefined_TF_Reduction_Xnor - | Iir_Predefined_TF_Reduction_Not => - -- TODO - raise Internal_Error; - - when Iir_Predefined_Bit_Array_Match_Equality - | Iir_Predefined_Bit_Array_Match_Inequality - | Iir_Predefined_Std_Ulogic_Array_Match_Equality - | Iir_Predefined_Std_Ulogic_Array_Match_Inequality => - -- TODO - raise Internal_Error; - end case; - exception - when Constraint_Error => - Warning_Msg_Sem ("arithmetic overflow in static expression", Orig); - return Build_Overflow (Orig); - end Eval_Dyadic_Operator; - - -- Evaluate any array attribute, return the type for the prefix. - function Eval_Array_Attribute (Attr : Iir) return Iir - is - Prefix : Iir; - Prefix_Type : Iir; - begin - Prefix := Get_Prefix (Attr); - case Get_Kind (Prefix) is - when Iir_Kinds_Object_Declaration -- FIXME: remove - | Iir_Kind_Selected_Element - | Iir_Kind_Indexed_Name - | Iir_Kind_Slice_Name - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Type_Declaration - | Iir_Kind_Implicit_Dereference => - Prefix_Type := Get_Type (Prefix); - when Iir_Kind_Attribute_Value => - -- The type of the attribute declaration may be unconstrained. - Prefix_Type := Get_Type - (Get_Expression (Get_Attribute_Specification (Prefix))); - when Iir_Kinds_Subtype_Definition => - Prefix_Type := Prefix; - when Iir_Kinds_Denoting_Name => - Prefix_Type := Get_Type (Prefix); - when others => - Error_Kind ("eval_array_attribute", Prefix); - end case; - if Get_Kind (Prefix_Type) /= Iir_Kind_Array_Subtype_Definition then - Error_Kind ("eval_array_attribute(2)", Prefix_Type); - end if; - return Get_Nth_Element (Get_Index_Subtype_List (Prefix_Type), - Natural (Get_Value (Get_Parameter (Attr)) - 1)); - end Eval_Array_Attribute; - - function Eval_Integer_Image (Val : Iir_Int64; Orig : Iir) return Iir - is - use Str_Table; - Img : String (1 .. 24); -- 23 is enough, 24 is rounded. - L : Natural; - V : Iir_Int64; - Id : String_Id; - begin - V := Val; - L := Img'Last; - loop - Img (L) := Character'Val (Character'Pos ('0') + abs (V rem 10)); - V := V / 10; - L := L - 1; - exit when V = 0; - end loop; - if Val < 0 then - Img (L) := '-'; - L := L - 1; - end if; - Id := Start; - for I in L + 1 .. Img'Last loop - Append (Img (I)); - end loop; - Finish; - return Build_String (Id, Int32 (Img'Last - L), Orig); - end Eval_Integer_Image; - - function Eval_Floating_Image (Val : Iir_Fp64; Orig : Iir) return Iir - is - use Str_Table; - Id : String_Id; - - -- Sign (1) + digit (1) + dot (1) + digits (15) + exp (1) + sign (1) - -- + exp_digits (4) -> 24. - Str : String (1 .. 25); - P : Natural; - V : Iir_Fp64; - Vd : Iir_Fp64; - Exp : Integer; - D : Integer; - B : Boolean; - - Res : Iir; - begin - -- Handle sign. - if Val < 0.0 then - Str (1) := '-'; - P := 1; - V := -Val; - else - P := 0; - V := Val; - end if; - - -- Compute the mantissa. - -- FIXME: should do a dichotomy. - if V = 0.0 then - Exp := 0; - elsif V < 1.0 then - Exp := -1; - while V * (10.0 ** (-Exp)) < 1.0 loop - Exp := Exp - 1; - end loop; - else - Exp := 0; - while V / (10.0 ** Exp) >= 10.0 loop - Exp := Exp + 1; - end loop; - end if; - - -- Normalize VAL: in [0; 10[ - if Exp >= 0 then - V := V / (10.0 ** Exp); - else - V := V * 10.0 ** (-Exp); - end if; - - for I in 0 .. 15 loop - Vd := Iir_Fp64'Truncation (V); - P := P + 1; - Str (P) := Character'Val (48 + Integer (Vd)); - V := (V - Vd) * 10.0; - - if I = 0 then - P := P + 1; - Str (P) := '.'; - end if; - exit when I > 0 and V < 10.0 ** (I + 1 - 15); - end loop; - - if Exp /= 0 then - -- LRM93 14.3 - -- if the exponent is present, the `e' is written as a lower case - -- character. - P := P + 1; - Str (P) := 'e'; - - if Exp < 0 then - P := P + 1; - Str (P) := '-'; - Exp := -Exp; - end if; - B := False; - for I in 0 .. 4 loop - D := (Exp / 10000) mod 10; - if D /= 0 or B or I = 4 then - P := P + 1; - Str (P) := Character'Val (48 + D); - B := True; - end if; - Exp := (Exp - D * 10000) * 10; - end loop; - end if; - - Id := Start; - for I in 1 .. P loop - Append (Str (I)); - end loop; - Finish; - Res := Build_String (Id, Int32 (P), Orig); - -- FIXME: this is not correct since the type is *not* constrained. - Set_Type (Res, Create_Unidim_Array_By_Length - (Get_Type (Orig), Iir_Int64 (P), Orig)); - return Res; - end Eval_Floating_Image; - - function Eval_Enumeration_Image (Enum, Expr : Iir) return Iir - is - Name : constant String := Image_Identifier (Enum); - Image_Id : constant String_Id := Str_Table.Start; - begin - for i in Name'range loop - Str_Table.Append(Name(i)); - end loop; - Str_Table.Finish; - return Build_String (Image_Id, Nat32(Name'Length), Expr); - end Eval_Enumeration_Image; - - function Build_Enumeration_Value (Val : String; Enum, Expr : Iir) return Iir - is - Value : String (Val'range); - List : constant Iir_List := Get_Enumeration_Literal_List (Enum); - begin - for I in Val'range loop - Value (I) := Ada.Characters.Handling.To_Lower (Val (I)); - end loop; - for I in 0 .. Get_Nbr_Elements (List) - 1 loop - if Value = Image_Identifier (Get_Nth_Element (List, I)) then - return Build_Enumeration (Iir_Index32 (I), Expr); - end if; - end loop; - Warning_Msg_Sem ("value """ & Value & """ not in enumeration", Expr); - return Build_Overflow (Expr); - end Build_Enumeration_Value; - - function Eval_Physical_Image (Phys, Expr: Iir) return Iir - is - -- Reduces to the base unit (e.g. femtoseconds). - Value : constant String := Iir_Int64'Image (Get_Physical_Value (Phys)); - Unit : constant Iir := - Get_Primary_Unit (Get_Base_Type (Get_Type (Phys))); - UnitName : constant String := Image_Identifier (Unit); - Image_Id : constant String_Id := Str_Table.Start; - Length : Nat32 := Value'Length + UnitName'Length + 1; - begin - for I in Value'range loop - -- Suppress the Ada +ve integer'image leading space - if I > Value'first or else Value (I) /= ' ' then - Str_Table.Append (Value (I)); - else - Length := Length - 1; - end if; - end loop; - Str_Table.Append (' '); - for I in UnitName'range loop - Str_Table.Append (UnitName (I)); - end loop; - Str_Table.Finish; - - return Build_String (Image_Id, Length, Expr); - end Eval_Physical_Image; - - function Build_Physical_Value (Val: String; Phys_Type, Expr: Iir) return Iir - is - function White (C : in Character) return Boolean is - NBSP : constant Character := Character'Val (160); - HT : constant Character := Character'Val (9); - begin - return C = ' ' or C = NBSP or C = HT; - end White; - - UnitName : String (Val'range); - Mult : Iir_Int64; - Sep : Natural; - Found_Unit : Boolean := false; - Found_Real : Boolean := false; - Unit : Iir := Get_Primary_Unit (Phys_Type); - begin - -- Separate string into numeric value and make lowercase unit. - for I in reverse Val'range loop - UnitName (I) := Ada.Characters.Handling.To_Lower (Val (I)); - if White (Val (I)) and Found_Unit then - Sep := I; - exit; - else - Found_Unit := true; - end if; - end loop; - - -- Unit name is UnitName(Sep+1..Unit'Last) - for I in Val'First .. Sep loop - if Val (I) = '.' then - Found_Real := true; - end if; - end loop; - - -- Chain down the units looking for matching one - Unit := Get_Primary_Unit (Phys_Type); - while Unit /= Null_Iir loop - exit when (UnitName (Sep + 1 .. UnitName'Last) - = Image_Identifier (Unit)); - Unit := Get_Chain (Unit); - end loop; - if Unit = Null_Iir then - Warning_Msg_Sem ("Unit """ & UnitName (Sep + 1 .. UnitName'Last) - & """ not in physical type", Expr); - return Build_Overflow (Expr); - end if; - - Mult := Get_Value (Get_Physical_Unit_Value (Unit)); - if Found_Real then - return Build_Physical - (Iir_Int64 (Iir_Fp64'Value (Val (Val'First .. Sep)) - * Iir_Fp64 (Mult)), - Expr); - else - return Build_Physical - (Iir_Int64'Value (Val (Val'First .. Sep)) * Mult, Expr); - end if; - end Build_Physical_Value; - - function Eval_Incdec (Expr : Iir; N : Iir_Int64; Origin : Iir) return Iir - is - P : Iir_Int64; - begin - case Get_Kind (Expr) is - when Iir_Kind_Integer_Literal => - return Build_Integer (Get_Value (Expr) + N, Origin); - when Iir_Kind_Enumeration_Literal => - P := Iir_Int64 (Get_Enum_Pos (Expr)) + N; - if P < 0 then - Warning_Msg_Sem ("static constant violates bounds", Expr); - return Build_Overflow (Origin); - else - return Build_Enumeration (Iir_Index32 (P), Origin); - end if; - when Iir_Kind_Physical_Int_Literal - | Iir_Kind_Unit_Declaration => - return Build_Physical (Get_Physical_Value (Expr) + N, Origin); - when others => - Error_Kind ("eval_incdec", Expr); - end case; - end Eval_Incdec; - - function Convert_Range (Rng : Iir; Res_Type : Iir; Loc : Iir) return Iir - is - Res_Btype : Iir; - - function Create_Bound (Val : Iir) return Iir - is - R : Iir; - begin - R := Create_Iir (Iir_Kind_Integer_Literal); - Location_Copy (R, Loc); - Set_Value (R, Get_Value (Val)); - Set_Type (R, Res_Btype); - Set_Expr_Staticness (R, Locally); - return R; - end Create_Bound; - - Res : Iir; - begin - Res_Btype := Get_Base_Type (Res_Type); - Res := Create_Iir (Iir_Kind_Range_Expression); - Location_Copy (Res, Loc); - Set_Type (Res, Res_Btype); - Set_Left_Limit (Res, Create_Bound (Get_Left_Limit (Rng))); - Set_Right_Limit (Res, Create_Bound (Get_Right_Limit (Rng))); - Set_Direction (Res, Get_Direction (Rng)); - Set_Expr_Staticness (Res, Locally); - return Res; - end Convert_Range; - - function Eval_Array_Type_Conversion (Conv : Iir; Val : Iir) return Iir - is - Conv_Type : constant Iir := Get_Type (Conv); - Val_Type : constant Iir := Get_Type (Val); - Conv_Index_Type : constant Iir := Get_Index_Type (Conv_Type, 0); - Val_Index_Type : constant Iir := Get_Index_Type (Val_Type, 0); - Index_Type : Iir; - Res_Type : Iir; - Res : Iir; - Rng : Iir; - begin - -- The expression is either a simple aggregate or a (bit) string. - Res := Build_Constant (Val, Conv); - case Get_Kind (Conv_Type) is - when Iir_Kind_Array_Subtype_Definition => - Set_Type (Res, Conv_Type); - if Eval_Discrete_Type_Length (Conv_Index_Type) - /= Eval_Discrete_Type_Length (Val_Index_Type) - then - Warning_Msg_Sem - ("non matching length in type conversion", Conv); - return Build_Overflow (Conv); - end if; - return Res; - when Iir_Kind_Array_Type_Definition => - if Get_Base_Type (Conv_Index_Type) = Get_Base_Type (Val_Index_Type) - then - Index_Type := Val_Index_Type; - else - -- Convert the index range. - -- It is an integer type. - Rng := Convert_Range (Get_Range_Constraint (Val_Index_Type), - Conv_Index_Type, Conv); - Index_Type := Create_Iir (Iir_Kind_Integer_Subtype_Definition); - Location_Copy (Index_Type, Conv); - Set_Range_Constraint (Index_Type, Rng); - Set_Base_Type (Index_Type, Get_Base_Type (Conv_Index_Type)); - Set_Type_Staticness (Index_Type, Locally); - end if; - Res_Type := Create_Unidim_Array_From_Index - (Get_Base_Type (Conv_Type), Index_Type, Conv); - Set_Type (Res, Res_Type); - Set_Type_Conversion_Subtype (Conv, Res_Type); - return Res; - when others => - Error_Kind ("eval_array_type_conversion", Conv_Type); - end case; - end Eval_Array_Type_Conversion; - - function Eval_Type_Conversion (Expr : Iir) return Iir - is - Val : Iir; - Val_Type : Iir; - Conv_Type : Iir; - begin - Val := Eval_Static_Expr (Get_Expression (Expr)); - Val_Type := Get_Base_Type (Get_Type (Val)); - Conv_Type := Get_Base_Type (Get_Type (Expr)); - if Conv_Type = Val_Type then - return Build_Constant (Val, Expr); - end if; - case Get_Kind (Conv_Type) is - when Iir_Kind_Integer_Type_Definition => - case Get_Kind (Val_Type) is - when Iir_Kind_Integer_Type_Definition => - return Build_Integer (Get_Value (Val), Expr); - when Iir_Kind_Floating_Type_Definition => - return Build_Integer (Iir_Int64 (Get_Fp_Value (Val)), Expr); - when others => - Error_Kind ("eval_type_conversion(1)", Val_Type); - end case; - when Iir_Kind_Floating_Type_Definition => - case Get_Kind (Val_Type) is - when Iir_Kind_Integer_Type_Definition => - return Build_Floating (Iir_Fp64 (Get_Value (Val)), Expr); - when Iir_Kind_Floating_Type_Definition => - return Build_Floating (Get_Fp_Value (Val), Expr); - when others => - Error_Kind ("eval_type_conversion(2)", Val_Type); - end case; - when Iir_Kind_Array_Type_Definition => - return Eval_Array_Type_Conversion (Expr, Val); - when others => - Error_Kind ("eval_type_conversion(3)", Conv_Type); - end case; - end Eval_Type_Conversion; - - function Eval_Physical_Literal (Expr : Iir) return Iir - is - Val : Iir; - begin - case Get_Kind (Expr) is - when Iir_Kind_Physical_Fp_Literal => - Val := Expr; - when Iir_Kind_Physical_Int_Literal => - if Get_Named_Entity (Get_Unit_Name (Expr)) - = Get_Primary_Unit (Get_Base_Type (Get_Type (Expr))) - then - return Expr; - else - Val := Expr; - end if; - when Iir_Kind_Unit_Declaration => - Val := Expr; - when Iir_Kinds_Denoting_Name => - Val := Get_Named_Entity (Expr); - pragma Assert (Get_Kind (Val) = Iir_Kind_Unit_Declaration); - when others => - Error_Kind ("eval_physical_literal", Expr); - end case; - return Build_Physical (Get_Physical_Value (Val), Expr); - end Eval_Physical_Literal; - - function Eval_Static_Expr (Expr: Iir) return Iir - is - Res : Iir; - Val : Iir; - begin - case Get_Kind (Expr) is - when Iir_Kinds_Denoting_Name => - return Eval_Static_Expr (Get_Named_Entity (Expr)); - - when Iir_Kind_Integer_Literal - | Iir_Kind_Enumeration_Literal - | Iir_Kind_Floating_Point_Literal - | Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal - | Iir_Kind_Overflow_Literal - | Iir_Kind_Physical_Int_Literal - | Iir_Kind_Physical_Fp_Literal => - return Expr; - when Iir_Kind_Constant_Declaration => - Val := Eval_Static_Expr (Get_Default_Value (Expr)); - -- Type of the expression should be type of the constant - -- declaration at least in case of array subtype. - -- If the constant is declared as an unconstrained array, get type - -- from the default value. - -- FIXME: handle this during semantisation of the declaration: - -- add an implicit subtype conversion node ? - -- FIXME: this currently creates a node at each evalation. - if Get_Kind (Get_Type (Val)) = Iir_Kind_Array_Type_Definition then - Res := Build_Constant (Val, Expr); - Set_Type (Res, Get_Type (Val)); - return Res; - else - return Val; - end if; - when Iir_Kind_Object_Alias_Declaration => - return Eval_Static_Expr (Get_Name (Expr)); - when Iir_Kind_Unit_Declaration => - return Get_Physical_Unit_Value (Expr); - when Iir_Kind_Simple_Aggregate => - return Expr; - - when Iir_Kind_Parenthesis_Expression => - return Eval_Static_Expr (Get_Expression (Expr)); - when Iir_Kind_Qualified_Expression => - return Eval_Static_Expr (Get_Expression (Expr)); - when Iir_Kind_Type_Conversion => - return Eval_Type_Conversion (Expr); - - when Iir_Kinds_Monadic_Operator => - declare - Operand : Iir; - begin - Operand := Eval_Static_Expr (Get_Operand (Expr)); - return Eval_Monadic_Operator (Expr, Operand); - end; - when Iir_Kinds_Dyadic_Operator => - declare - Left : constant Iir := Get_Left (Expr); - Right : constant Iir := Get_Right (Expr); - Left_Val, Right_Val : Iir; - Res : Iir; - begin - Left_Val := Eval_Static_Expr (Left); - Right_Val := Eval_Static_Expr (Right); - - Res := Eval_Dyadic_Operator - (Expr, Get_Implementation (Expr), Left_Val, Right_Val); - - Free_Eval_Static_Expr (Left_Val, Left); - Free_Eval_Static_Expr (Right_Val, Right); - - return Res; - end; - - when Iir_Kind_Attribute_Name => - -- An attribute name designates an attribute value. - declare - Attr_Val : constant Iir := Get_Named_Entity (Expr); - Attr_Expr : constant Iir := - Get_Expression (Get_Attribute_Specification (Attr_Val)); - Val : Iir; - begin - Val := Eval_Static_Expr (Attr_Expr); - -- FIXME: see constant_declaration. - -- Currently, this avoids weird nodes, such as a string literal - -- whose type is an unconstrained array type. - Res := Build_Constant (Val, Expr); - Set_Type (Res, Get_Type (Val)); - return Res; - end; - - when Iir_Kind_Pos_Attribute => - declare - Param : constant Iir := Get_Parameter (Expr); - Val : Iir; - Res : Iir; - begin - Val := Eval_Static_Expr (Param); - -- FIXME: check bounds, handle overflow. - Res := Build_Integer (Eval_Pos (Val), Expr); - Free_Eval_Static_Expr (Val, Param); - return Res; - end; - when Iir_Kind_Val_Attribute => - declare - Expr_Type : constant Iir := Get_Type (Expr); - Val_Expr : Iir; - Val : Iir_Int64; - begin - Val_Expr := Eval_Static_Expr (Get_Parameter (Expr)); - Val := Eval_Pos (Val_Expr); - -- Note: the type of 'val is a base type. - -- FIXME: handle VHDL93 restrictions. - if Get_Kind (Expr_Type) = Iir_Kind_Enumeration_Type_Definition - and then - not Eval_Int_In_Range (Val, Get_Range_Constraint (Expr_Type)) - then - Warning_Msg_Sem - ("static argument out of the type range", Expr); - return Build_Overflow (Expr); - end if; - if Get_Kind (Get_Base_Type (Get_Type (Expr))) - = Iir_Kind_Physical_Type_Definition - then - return Build_Physical (Val, Expr); - else - return Build_Discrete (Val, Expr); - end if; - end; - when Iir_Kind_Image_Attribute => - declare - Param : Iir; - Param_Type : Iir; - begin - Param := Get_Parameter (Expr); - Param := Eval_Static_Expr (Param); - Set_Parameter (Expr, Param); - Param_Type := Get_Base_Type (Get_Type (Param)); - case Get_Kind (Param_Type) is - when Iir_Kind_Integer_Type_Definition => - return Eval_Integer_Image (Get_Value (Param), Expr); - when Iir_Kind_Floating_Type_Definition => - return Eval_Floating_Image (Get_Fp_Value (Param), Expr); - when Iir_Kind_Enumeration_Type_Definition => - return Eval_Enumeration_Image (Param, Expr); - when Iir_Kind_Physical_Type_Definition => - return Eval_Physical_Image (Param, Expr); - when others => - Error_Kind ("eval_static_expr('image)", Param); - end case; - end; - when Iir_Kind_Value_Attribute => - declare - Param : Iir; - Param_Type : Iir; - begin - Param := Get_Parameter (Expr); - Param := Eval_Static_Expr (Param); - Set_Parameter (Expr, Param); - if Get_Kind (Param) /= Iir_Kind_String_Literal then - -- FIXME: Isn't it an implementation restriction. - Warning_Msg_Sem ("'value argument not a string", Expr); - return Build_Overflow (Expr); - else - -- what type are we converting the string to? - Param_Type := Get_Base_Type (Get_Type (Expr)); - declare - Value : constant String := Image_String_Lit (Param); - begin - case Get_Kind (Param_Type) is - when Iir_Kind_Integer_Type_Definition => - return Build_Discrete (Iir_Int64'Value (Value), Expr); - when Iir_Kind_Enumeration_Type_Definition => - return Build_Enumeration_Value (Value, Param_Type, - Expr); - when Iir_Kind_Floating_Type_Definition => - return Build_Floating (Iir_Fp64'value (Value), Expr); - when Iir_Kind_Physical_Type_Definition => - return Build_Physical_Value (Value, Param_Type, Expr); - when others => - Error_Kind ("eval_static_expr('value)", Param); - end case; - end; - end if; - end; - - when Iir_Kind_Left_Type_Attribute => - return Eval_Static_Expr - (Get_Left_Limit (Eval_Static_Range (Get_Prefix (Expr)))); - when Iir_Kind_Right_Type_Attribute => - return Eval_Static_Expr - (Get_Right_Limit (Eval_Static_Range (Get_Prefix (Expr)))); - when Iir_Kind_High_Type_Attribute => - return Eval_Static_Expr - (Get_High_Limit (Eval_Static_Range (Get_Prefix (Expr)))); - when Iir_Kind_Low_Type_Attribute => - return Eval_Static_Expr - (Get_Low_Limit (Eval_Static_Range (Get_Prefix (Expr)))); - when Iir_Kind_Ascending_Type_Attribute => - return Build_Boolean - (Get_Direction (Eval_Static_Range (Get_Prefix (Expr))) = Iir_To); - - when Iir_Kind_Length_Array_Attribute => - declare - Index : Iir; - begin - Index := Eval_Array_Attribute (Expr); - return Build_Discrete (Eval_Discrete_Type_Length (Index), Expr); - end; - when Iir_Kind_Left_Array_Attribute => - declare - Index : Iir; - begin - Index := Eval_Array_Attribute (Expr); - return Eval_Static_Expr - (Get_Left_Limit (Get_Range_Constraint (Index))); - end; - when Iir_Kind_Right_Array_Attribute => - declare - Index : Iir; - begin - Index := Eval_Array_Attribute (Expr); - return Eval_Static_Expr - (Get_Right_Limit (Get_Range_Constraint (Index))); - end; - when Iir_Kind_Low_Array_Attribute => - declare - Index : Iir; - begin - Index := Eval_Array_Attribute (Expr); - return Eval_Static_Expr - (Get_Low_Limit (Get_Range_Constraint (Index))); - end; - when Iir_Kind_High_Array_Attribute => - declare - Index : Iir; - begin - Index := Eval_Array_Attribute (Expr); - return Eval_Static_Expr - (Get_High_Limit (Get_Range_Constraint (Index))); - end; - when Iir_Kind_Ascending_Array_Attribute => - declare - Index : Iir; - begin - Index := Eval_Array_Attribute (Expr); - return Build_Boolean - (Get_Direction (Get_Range_Constraint (Index)) = Iir_To); - end; - - when Iir_Kind_Pred_Attribute => - Res := Eval_Incdec - (Eval_Static_Expr (Get_Parameter (Expr)), -1, Expr); - Eval_Check_Bound (Res, Get_Type (Get_Prefix (Expr))); - return Res; - when Iir_Kind_Succ_Attribute => - Res := Eval_Incdec - (Eval_Static_Expr (Get_Parameter (Expr)), +1, Expr); - Eval_Check_Bound (Res, Get_Type (Get_Prefix (Expr))); - return Res; - when Iir_Kind_Leftof_Attribute - | Iir_Kind_Rightof_Attribute => - declare - Rng : Iir; - N : Iir_Int64; - Prefix_Type : Iir; - Res : Iir; - begin - Prefix_Type := Get_Type (Get_Prefix (Expr)); - Rng := Eval_Static_Range (Prefix_Type); - case Get_Direction (Rng) is - when Iir_To => - N := 1; - when Iir_Downto => - N := -1; - end case; - case Get_Kind (Expr) is - when Iir_Kind_Leftof_Attribute => - N := -N; - when Iir_Kind_Rightof_Attribute => - null; - when others => - raise Internal_Error; - end case; - Res := Eval_Incdec - (Eval_Static_Expr (Get_Parameter (Expr)), N, Expr); - Eval_Check_Bound (Res, Prefix_Type); - return Res; - end; - - when Iir_Kind_Simple_Name_Attribute => - declare - use Str_Table; - Id : String_Id; - begin - Id := Start; - Image (Get_Simple_Name_Identifier (Expr)); - for I in 1 .. Name_Length loop - Append (Name_Buffer (I)); - end loop; - Finish; - return Build_String (Id, Nat32 (Name_Length), Expr); - end; - - when Iir_Kind_Null_Literal => - return Expr; - - when Iir_Kind_Function_Call => - declare - Imp : constant Iir := Get_Implementation (Expr); - Left, Right : Iir; - begin - -- Note: there can't be association by name. - Left := Get_Parameter_Association_Chain (Expr); - Right := Get_Chain (Left); - - Left := Eval_Static_Expr (Get_Actual (Left)); - if Right = Null_Iir then - return Eval_Monadic_Operator (Expr, Left); - else - Right := Eval_Static_Expr (Get_Actual (Right)); - return Eval_Dyadic_Operator (Expr, Imp, Left, Right); - end if; - end; - - when Iir_Kind_Error => - return Expr; - when others => - Error_Kind ("eval_static_expr", Expr); - end case; - end Eval_Static_Expr; - - -- If FORCE is true, always return a literal. - function Eval_Expr_Keep_Orig (Expr : Iir; Force : Boolean) return Iir - is - Res : Iir; - begin - case Get_Kind (Expr) is - when Iir_Kinds_Denoting_Name => - declare - Orig : constant Iir := Get_Named_Entity (Expr); - begin - Res := Eval_Static_Expr (Orig); - if Res /= Orig or else Force then - return Build_Constant (Res, Expr); - else - return Expr; - end if; - end; - when others => - Res := Eval_Static_Expr (Expr); - if Res /= Expr - and then Get_Literal_Origin (Res) /= Expr - then - -- Need to build a constant if the result is a different - -- literal not tied to EXPR. - return Build_Constant (Res, Expr); - else - return Res; - end if; - end case; - end Eval_Expr_Keep_Orig; - - function Eval_Expr (Expr: Iir) return Iir is - begin - if Get_Expr_Staticness (Expr) /= Locally then - Error_Msg_Sem ("expression must be locally static", Expr); - return Expr; - else - return Eval_Expr_Keep_Orig (Expr, False); - end if; - end Eval_Expr; - - function Eval_Expr_If_Static (Expr : Iir) return Iir is - begin - if Expr /= Null_Iir and then Get_Expr_Staticness (Expr) = Locally then - return Eval_Expr_Keep_Orig (Expr, False); - else - return Expr; - end if; - end Eval_Expr_If_Static; - - function Eval_Expr_Check (Expr : Iir; Sub_Type : Iir) return Iir - is - Res : Iir; - begin - Res := Eval_Expr_Keep_Orig (Expr, False); - Eval_Check_Bound (Res, Sub_Type); - return Res; - end Eval_Expr_Check; - - function Eval_Expr_Check_If_Static (Expr : Iir; Atype : Iir) return Iir - is - Res : Iir; - begin - if Expr /= Null_Iir and then Get_Expr_Staticness (Expr) = Locally then - -- Expression is static and can be evaluated. - Res := Eval_Expr_Keep_Orig (Expr, False); - - if Res /= Null_Iir - and then Get_Type_Staticness (Atype) = Locally - and then Get_Kind (Atype) in Iir_Kinds_Range_Type_Definition - then - -- Check bounds (as this can be done). - -- FIXME: create overflow_expr ? - Eval_Check_Bound (Res, Atype); - end if; - - return Res; - else - return Expr; - end if; - end Eval_Expr_Check_If_Static; - - function Eval_Int_In_Range (Val : Iir_Int64; Bound : Iir) return Boolean is - begin - case Get_Kind (Bound) is - when Iir_Kind_Range_Expression => - case Get_Direction (Bound) is - when Iir_To => - if Val < Eval_Pos (Get_Left_Limit (Bound)) - or else Val > Eval_Pos (Get_Right_Limit (Bound)) - then - return False; - end if; - when Iir_Downto => - if Val > Eval_Pos (Get_Left_Limit (Bound)) - or else Val < Eval_Pos (Get_Right_Limit (Bound)) - then - return False; - end if; - end case; - when others => - Error_Kind ("eval_int_in_range", Bound); - end case; - return True; - end Eval_Int_In_Range; - - function Eval_Phys_In_Range (Val : Iir_Int64; Bound : Iir) return Boolean - is - Left, Right : Iir_Int64; - begin - case Get_Kind (Bound) is - when Iir_Kind_Range_Expression => - case Get_Kind (Get_Type (Get_Left_Limit (Bound))) is - when Iir_Kind_Integer_Type_Definition - | Iir_Kind_Integer_Subtype_Definition => - Left := Get_Value (Get_Left_Limit (Bound)); - Right := Get_Value (Get_Right_Limit (Bound)); - when Iir_Kind_Physical_Type_Definition - | Iir_Kind_Physical_Subtype_Definition => - Left := Get_Physical_Value (Get_Left_Limit (Bound)); - Right := Get_Physical_Value (Get_Right_Limit (Bound)); - when others => - Error_Kind ("eval_phys_in_range(1)", Get_Type (Bound)); - end case; - case Get_Direction (Bound) is - when Iir_To => - if Val < Left or else Val > Right then - return False; - end if; - when Iir_Downto => - if Val > Left or else Val < Right then - return False; - end if; - end case; - when others => - Error_Kind ("eval_phys_in_range", Bound); - end case; - return True; - end Eval_Phys_In_Range; - - function Eval_Fp_In_Range (Val : Iir_Fp64; Bound : Iir) return Boolean is - begin - case Get_Kind (Bound) is - when Iir_Kind_Range_Expression => - case Get_Direction (Bound) is - when Iir_To => - if Val < Get_Fp_Value (Get_Left_Limit (Bound)) - or else Val > Get_Fp_Value (Get_Right_Limit (Bound)) - then - return False; - end if; - when Iir_Downto => - if Val > Get_Fp_Value (Get_Left_Limit (Bound)) - or else Val < Get_Fp_Value (Get_Right_Limit (Bound)) - then - return False; - end if; - end case; - when others => - Error_Kind ("eval_fp_in_range", Bound); - end case; - return True; - end Eval_Fp_In_Range; - - -- Return TRUE if literal EXPR is in SUB_TYPE bounds. - function Eval_Is_In_Bound (Expr : Iir; Sub_Type : Iir) return Boolean - is - Type_Range : Iir; - Val : Iir; - begin - case Get_Kind (Expr) is - when Iir_Kind_Error => - -- Ignore errors. - return True; - when Iir_Kind_Overflow_Literal => - -- Never within bounds - return False; - when Iir_Kind_Simple_Name - | Iir_Kind_Character_Literal - | Iir_Kind_Selected_Name => - Val := Get_Named_Entity (Expr); - when others => - Val := Expr; - end case; - - case Get_Kind (Sub_Type) is - when Iir_Kind_Integer_Subtype_Definition => - Type_Range := Get_Range_Constraint (Sub_Type); - return Eval_Int_In_Range (Get_Value (Val), Type_Range); - when Iir_Kind_Floating_Subtype_Definition => - Type_Range := Get_Range_Constraint (Sub_Type); - return Eval_Fp_In_Range (Get_Fp_Value (Val), Type_Range); - when Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition => - -- A check is required for an enumeration type definition for - -- 'val attribute. - Type_Range := Get_Range_Constraint (Sub_Type); - return Eval_Int_In_Range - (Iir_Int64 (Get_Enum_Pos (Val)), Type_Range); - when Iir_Kind_Physical_Subtype_Definition => - Type_Range := Get_Range_Constraint (Sub_Type); - return Eval_Phys_In_Range (Get_Physical_Value (Val), Type_Range); - - when Iir_Kind_Base_Attribute => - return Eval_Is_In_Bound (Val, Get_Type (Sub_Type)); - - when Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Array_Type_Definition - | Iir_Kind_Record_Type_Definition => - -- FIXME: do it. - return True; - - when others => - Error_Kind ("eval_is_in_bound", Sub_Type); - end case; - end Eval_Is_In_Bound; - - procedure Eval_Check_Bound (Expr : Iir; Sub_Type : Iir) is - begin - if Get_Kind (Expr) = Iir_Kind_Overflow_Literal then - -- Nothing to check, and a message was already generated. - return; - end if; - - if not Eval_Is_In_Bound (Expr, Sub_Type) then - Error_Msg_Sem ("static constant violates bounds", Expr); - end if; - end Eval_Check_Bound; - - function Eval_Is_Range_In_Bound - (A_Range : Iir; Sub_Type : Iir; Any_Dir : Boolean) - return Boolean - is - Type_Range : Iir; - Range_Constraint : constant Iir := Eval_Static_Range (A_Range); - begin - Type_Range := Get_Range_Constraint (Sub_Type); - if not Any_Dir - and then Get_Direction (Type_Range) /= Get_Direction (Range_Constraint) - then - return True; - end if; - - case Get_Kind (Sub_Type) is - when Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition => - declare - L, R : Iir_Int64; - begin - -- Check for null range. - L := Eval_Pos (Get_Left_Limit (Range_Constraint)); - R := Eval_Pos (Get_Right_Limit (Range_Constraint)); - case Get_Direction (Range_Constraint) is - when Iir_To => - if L > R then - return True; - end if; - when Iir_Downto => - if L < R then - return True; - end if; - end case; - return Eval_Int_In_Range (L, Type_Range) - and then Eval_Int_In_Range (R, Type_Range); - end; - when Iir_Kind_Floating_Subtype_Definition => - declare - L, R : Iir_Fp64; - begin - -- Check for null range. - L := Get_Fp_Value (Get_Left_Limit (Range_Constraint)); - R := Get_Fp_Value (Get_Right_Limit (Range_Constraint)); - case Get_Direction (Range_Constraint) is - when Iir_To => - if L > R then - return True; - end if; - when Iir_Downto => - if L < R then - return True; - end if; - end case; - return Eval_Fp_In_Range (L, Type_Range) - and then Eval_Fp_In_Range (R, Type_Range); - end; - when others => - Error_Kind ("eval_is_range_in_bound", Sub_Type); - end case; - - -- Should check L <= R or L >= R according to direction. - --return Eval_Is_In_Bound (Get_Left_Limit (A_Range), Sub_Type) - -- and then Eval_Is_In_Bound (Get_Right_Limit (A_Range), Sub_Type); - end Eval_Is_Range_In_Bound; - - procedure Eval_Check_Range - (A_Range : Iir; Sub_Type : Iir; Any_Dir : Boolean) - is - begin - if not Eval_Is_Range_In_Bound (A_Range, Sub_Type, Any_Dir) then - Error_Msg_Sem ("static range violates bounds", A_Range); - end if; - end Eval_Check_Range; - - function Eval_Discrete_Range_Length (Constraint : Iir) return Iir_Int64 - is - Res : Iir_Int64; - Left, Right : Iir_Int64; - begin - Left := Eval_Pos (Get_Left_Limit (Constraint)); - Right := Eval_Pos (Get_Right_Limit (Constraint)); - case Get_Direction (Constraint) is - when Iir_To => - if Right < Left then - -- Null range. - return 0; - else - Res := Right - Left + 1; - end if; - when Iir_Downto => - if Left < Right then - -- Null range - return 0; - else - Res := Left - Right + 1; - end if; - end case; - return Res; - end Eval_Discrete_Range_Length; - - function Eval_Discrete_Type_Length (Sub_Type : Iir) return Iir_Int64 - is - begin - case Get_Kind (Sub_Type) is - when Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Integer_Subtype_Definition => - return Eval_Discrete_Range_Length - (Get_Range_Constraint (Sub_Type)); - when others => - Error_Kind ("eval_discrete_type_length", Sub_Type); - end case; - end Eval_Discrete_Type_Length; - - function Eval_Pos (Expr : Iir) return Iir_Int64 is - begin - case Get_Kind (Expr) is - when Iir_Kind_Integer_Literal => - return Get_Value (Expr); - when Iir_Kind_Enumeration_Literal => - return Iir_Int64 (Get_Enum_Pos (Expr)); - when Iir_Kind_Physical_Int_Literal - | Iir_Kind_Physical_Fp_Literal - | Iir_Kind_Unit_Declaration => - return Get_Physical_Value (Expr); - when Iir_Kinds_Denoting_Name => - return Eval_Pos (Get_Named_Entity (Expr)); - when others => - Error_Kind ("eval_pos", Expr); - end case; - end Eval_Pos; - - function Eval_Static_Range (Rng : Iir) return Iir - is - Expr : Iir; - Kind : Iir_Kind; - begin - Expr := Rng; - loop - Kind := Get_Kind (Expr); - case Kind is - when Iir_Kind_Range_Expression => - if Get_Expr_Staticness (Expr) /= Locally then - return Null_Iir; - end if; - - -- Normalize the range expression. - Set_Left_Limit - (Expr, Eval_Expr_Keep_Orig (Get_Left_Limit (Expr), True)); - Set_Right_Limit - (Expr, Eval_Expr_Keep_Orig (Get_Right_Limit (Expr), True)); - return Expr; - when Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition => - Expr := Get_Range_Constraint (Expr); - when Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute => - declare - Prefix : Iir; - Res : Iir; - begin - Prefix := Get_Prefix (Expr); - if Get_Kind (Prefix) /= Iir_Kind_Array_Subtype_Definition - then - Prefix := Get_Type (Prefix); - end if; - if Get_Kind (Prefix) /= Iir_Kind_Array_Subtype_Definition - then - -- Unconstrained object. - return Null_Iir; - end if; - Expr := Get_Nth_Element - (Get_Index_Subtype_List (Prefix), - Natural (Eval_Pos (Get_Parameter (Expr))) - 1); - if Kind = Iir_Kind_Reverse_Range_Array_Attribute then - Expr := Eval_Static_Range (Expr); - - Res := Create_Iir (Iir_Kind_Range_Expression); - Location_Copy (Res, Expr); - Set_Type (Res, Get_Type (Expr)); - case Get_Direction (Expr) is - when Iir_To => - Set_Direction (Res, Iir_Downto); - when Iir_Downto => - Set_Direction (Res, Iir_To); - end case; - Set_Left_Limit (Res, Get_Right_Limit (Expr)); - Set_Right_Limit (Res, Get_Left_Limit (Expr)); - Set_Range_Origin (Res, Rng); - Set_Expr_Staticness (Res, Get_Expr_Staticness (Expr)); - return Res; - end if; - end; - - when Iir_Kind_Subtype_Declaration - | Iir_Kind_Base_Attribute => - Expr := Get_Type (Expr); - when Iir_Kind_Type_Declaration => - Expr := Get_Type_Definition (Expr); - when Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name => - Expr := Get_Named_Entity (Expr); - when others => - Error_Kind ("eval_static_range", Expr); - end case; - end loop; - end Eval_Static_Range; - - function Eval_Range (Arange : Iir) return Iir is - Res : Iir; - begin - Res := Eval_Static_Range (Arange); - if Res /= Arange - and then Get_Range_Origin (Res) /= Arange - then - return Build_Constant_Range (Res, Arange); - else - return Res; - end if; - end Eval_Range; - - function Eval_Range_If_Static (Arange : Iir) return Iir is - begin - if Get_Expr_Staticness (Arange) /= Locally then - return Arange; - else - return Eval_Range (Arange); - end if; - end Eval_Range_If_Static; - - -- Return the range constraint of a discrete range. - function Eval_Discrete_Range_Expression (Constraint : Iir) return Iir - is - Res : Iir; - begin - Res := Eval_Static_Range (Constraint); - if Res = Null_Iir then - Error_Kind ("eval_discrete_range_expression", Constraint); - else - return Res; - end if; - end Eval_Discrete_Range_Expression; - - function Eval_Discrete_Range_Left (Constraint : Iir) return Iir - is - Range_Expr : Iir; - begin - Range_Expr := Eval_Discrete_Range_Expression (Constraint); - return Get_Left_Limit (Range_Expr); - end Eval_Discrete_Range_Left; - - procedure Eval_Operator_Symbol_Name (Id : Name_Id) - is - begin - Image (Id); - Name_Buffer (2 .. Name_Length + 1) := Name_Buffer (1 .. Name_Length); - Name_Buffer (1) := '"'; --" - Name_Length := Name_Length + 2; - Name_Buffer (Name_Length) := '"'; --" - end Eval_Operator_Symbol_Name; - - procedure Eval_Simple_Name (Id : Name_Id) - is - begin - -- LRM 14.1 - -- E'SIMPLE_NAME - -- Result: [...] but with apostrophes (in the case of a character - -- literal) - if Is_Character (Id) then - Name_Buffer (1) := '''; - Name_Buffer (2) := Get_Character (Id); - Name_Buffer (3) := '''; - Name_Length := 3; - return; - end if; - case Id is - when Std_Names.Name_Word_Operators - | Std_Names.Name_First_Operator .. Std_Names.Name_Last_Operator => - Eval_Operator_Symbol_Name (Id); - return; - when Std_Names.Name_Xnor - | Std_Names.Name_Shift_Operators => - if Flags.Vhdl_Std > Vhdl_87 then - Eval_Operator_Symbol_Name (Id); - return; - end if; - when others => - null; - end case; - Image (Id); --- if Name_Buffer (1) = '\' then --- declare --- I : Natural; --- begin --- I := 2; --- while I <= Name_Length loop --- if Name_Buffer (I) = '\' then --- Name_Length := Name_Length + 1; --- Name_Buffer (I + 1 .. Name_Length) := --- Name_Buffer (I .. Name_Length - 1); --- I := I + 1; --- end if; --- I := I + 1; --- end loop; --- Name_Length := Name_Length + 1; --- Name_Buffer (Name_Length) := '\'; --- end; --- end if; - end Eval_Simple_Name; - - function Compare_String_Literals (L, R : Iir) return Compare_Type - is - type Str_Info is record - El : Iir; - Ptr : String_Fat_Acc; - Len : Nat32; - Lit_0 : Iir; - Lit_1 : Iir; - List : Iir_List; - end record; - - Literal_List : Iir_List; - - -- Fill Res from EL. This is used to speed up Lt and Eq operations. - procedure Get_Info (Expr : Iir; Res : out Str_Info) is - begin - case Get_Kind (Expr) is - when Iir_Kind_Simple_Aggregate => - Res := Str_Info'(El => Expr, - Ptr => null, - Len => 0, - Lit_0 | Lit_1 => Null_Iir, - List => Get_Simple_Aggregate_List (Expr)); - Res.Len := Nat32 (Get_Nbr_Elements (Res.List)); - when Iir_Kind_Bit_String_Literal => - Res := Str_Info'(El => Expr, - Ptr => Get_String_Fat_Acc (Expr), - Len => Get_String_Length (Expr), - Lit_0 => Get_Bit_String_0 (Expr), - Lit_1 => Get_Bit_String_1 (Expr), - List => Null_Iir_List); - when Iir_Kind_String_Literal => - Res := Str_Info'(El => Expr, - Ptr => Get_String_Fat_Acc (Expr), - Len => Get_String_Length (Expr), - Lit_0 | Lit_1 => Null_Iir, - List => Null_Iir_List); - when others => - Error_Kind ("sem_string_choice_range.get_info", Expr); - end case; - end Get_Info; - - -- Return the position of element IDX of STR. - function Get_Pos (Str : Str_Info; Idx : Nat32) return Iir_Int32 - is - S : Iir; - C : Character; - begin - case Get_Kind (Str.El) is - when Iir_Kind_Simple_Aggregate => - S := Get_Nth_Element (Str.List, Natural (Idx)); - when Iir_Kind_String_Literal => - C := Str.Ptr (Idx + 1); - -- FIXME: build a table from character to position. - -- This linear search is O(n)! - S := Find_Name_In_List (Literal_List, - Name_Table.Get_Identifier (C)); - if S = Null_Iir then - return -1; - end if; - when Iir_Kind_Bit_String_Literal => - C := Str.Ptr (Idx + 1); - case C is - when '0' => - S := Str.Lit_0; - when '1' => - S := Str.Lit_1; - when others => - raise Internal_Error; - end case; - when others => - Error_Kind ("sem_string_choice_range.get_pos", Str.El); - end case; - return Get_Enum_Pos (S); - end Get_Pos; - - L_Info, R_Info : Str_Info; - L_Pos, R_Pos : Iir_Int32; - begin - Get_Info (L, L_Info); - Get_Info (R, R_Info); - - if L_Info.Len /= R_Info.Len then - raise Internal_Error; - end if; - - Literal_List := Get_Enumeration_Literal_List - (Get_Base_Type (Get_Element_Subtype (Get_Type (L)))); - - for I in 0 .. L_Info.Len - 1 loop - L_Pos := Get_Pos (L_Info, I); - R_Pos := Get_Pos (R_Info, I); - if L_Pos /= R_Pos then - if L_Pos < R_Pos then - return Compare_Lt; - else - return Compare_Gt; - end if; - end if; - end loop; - return Compare_Eq; - end Compare_String_Literals; - - function Get_Path_Instance_Name_Suffix (Attr : Iir) - return Path_Instance_Name_Type - is - -- Current path for name attributes. - Path_Str : String_Acc := null; - Path_Maxlen : Natural := 0; - Path_Len : Natural; - Path_Instance : Iir; - - procedure Deallocate is new Ada.Unchecked_Deallocation - (Name => String_Acc, Object => String); - - procedure Path_Reset is - begin - Path_Len := 0; - Path_Instance := Null_Iir; - if Path_Maxlen = 0 then - Path_Maxlen := 256; - Path_Str := new String (1 .. Path_Maxlen); - end if; - end Path_Reset; - - procedure Path_Add (Str : String) - is - N_Len : Natural; - N_Path : String_Acc; - begin - N_Len := Path_Maxlen; - loop - exit when Path_Len + Str'Length <= N_Len; - N_Len := N_Len * 2; - end loop; - if N_Len /= Path_Maxlen then - N_Path := new String (1 .. N_Len); - N_Path (1 .. Path_Len) := Path_Str (1 .. Path_Len); - Deallocate (Path_Str); - Path_Str := N_Path; - Path_Maxlen := N_Len; - end if; - Path_Str (Path_Len + 1 .. Path_Len + Str'Length) := Str; - Path_Len := Path_Len + Str'Length; - end Path_Add; - - procedure Path_Add_Type_Name (Atype : Iir) - is - Adecl : Iir; - begin - Adecl := Get_Type_Declarator (Atype); - Image (Get_Identifier (Adecl)); - Path_Add (Name_Buffer (1 .. Name_Length)); - end Path_Add_Type_Name; - - procedure Path_Add_Signature (Subprg : Iir) - is - Chain : Iir; - begin - Path_Add ("["); - Chain := Get_Interface_Declaration_Chain (Subprg); - while Chain /= Null_Iir loop - Path_Add_Type_Name (Get_Type (Chain)); - Chain := Get_Chain (Chain); - if Chain /= Null_Iir then - Path_Add (","); - end if; - end loop; - - case Get_Kind (Subprg) is - when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration => - Path_Add (" return "); - Path_Add_Type_Name (Get_Return_Type (Subprg)); - when others => - null; - end case; - Path_Add ("]"); - end Path_Add_Signature; - - procedure Path_Add_Name (N : Iir) is - begin - Eval_Simple_Name (Get_Identifier (N)); - if Name_Buffer (1) /= 'P' then - -- Skip anonymous processes. - Path_Add (Name_Buffer (1 .. Name_Length)); - end if; - end Path_Add_Name; - - procedure Path_Add_Element (El : Iir; Is_Instance : Boolean) is - begin - -- LRM 14.1 - -- E'INSTANCE_NAME - -- There is one full path instance element for each component - -- instantiation, block statement, generate statemenent, process - -- statement, or subprogram body in the design hierarchy between - -- the top design entity and the named entity denoted by the - -- prefix. - -- - -- E'PATH_NAME - -- There is one path instance element for each component - -- instantiation, block statement, generate statement, process - -- statement, or subprogram body in the design hierarchy between - -- the root design entity and the named entity denoted by the - -- prefix. - case Get_Kind (El) is - when Iir_Kind_Library_Declaration => - Path_Add (":"); - Path_Add_Name (El); - Path_Add (":"); - when Iir_Kind_Package_Declaration - | Iir_Kind_Package_Body => - Path_Add_Element - (Get_Library (Get_Design_File (Get_Design_Unit (El))), - Is_Instance); - Path_Add_Name (El); - Path_Add (":"); - when Iir_Kind_Entity_Declaration => - Path_Instance := El; - when Iir_Kind_Architecture_Body => - Path_Instance := El; - when Iir_Kind_Design_Unit => - Path_Add_Element (Get_Library_Unit (El), Is_Instance); - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Block_Statement => - Path_Add_Element (Get_Parent (El), Is_Instance); - Path_Add_Name (El); - Path_Add (":"); - when Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - Path_Add_Element (Get_Parent (El), Is_Instance); - Path_Add_Name (El); - if Flags.Vhdl_Std >= Vhdl_02 then - -- Add signature. - Path_Add_Signature (El); - end if; - Path_Add (":"); - when Iir_Kind_Procedure_Body => - Path_Add_Element (Get_Subprogram_Specification (El), - Is_Instance); - when Iir_Kind_Generate_Statement => - declare - Scheme : Iir; - begin - Scheme := Get_Generation_Scheme (El); - if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then - Path_Instance := El; - else - Path_Add_Element (Get_Parent (El), Is_Instance); - Path_Add_Name (El); - Path_Add (":"); - end if; - end; - when Iir_Kinds_Sequential_Statement => - Path_Add_Element (Get_Parent (El), Is_Instance); - when others => - Error_Kind ("path_add_element", El); - end case; - end Path_Add_Element; - - Prefix : constant Iir := Get_Named_Entity (Get_Prefix (Attr)); - Is_Instance : constant Boolean := - Get_Kind (Attr) = Iir_Kind_Instance_Name_Attribute; - begin - Path_Reset; - - -- LRM 14.1 - -- E'PATH_NAME - -- The local item name in E'PATH_NAME equals E'SIMPLE_NAME, unless - -- E denotes a library, package, subprogram or label. In this - -- latter case, the package based path or instance based path, - -- as appropriate, will not contain a local item name. - -- - -- E'INSTANCE_NAME - -- The local item name in E'INSTANCE_NAME equals E'SIMPLE_NAME, - -- unless E denotes a library, package, subprogram, or label. In - -- this latter case, the package based path or full instance based - -- path, as appropriate, will not contain a local item name. - case Get_Kind (Prefix) is - when Iir_Kind_Constant_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Type_Declaration - | Iir_Kind_Subtype_Declaration => - Path_Add_Element (Get_Parent (Prefix), Is_Instance); - Path_Add_Name (Prefix); - when Iir_Kind_Library_Declaration - | Iir_Kinds_Library_Unit_Declaration - | Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kinds_Concurrent_Statement - | Iir_Kinds_Sequential_Statement => - Path_Add_Element (Prefix, Is_Instance); - when others => - Error_Kind ("get_path_instance_name_suffix", Prefix); - end case; - - declare - Result : constant Path_Instance_Name_Type := - (Len => Path_Len, - Path_Instance => Path_Instance, - Suffix => Path_Str (1 .. Path_Len)); - begin - Deallocate (Path_Str); - return Result; - end; - end Get_Path_Instance_Name_Suffix; - -end Evaluation; diff --git a/evaluation.ads b/evaluation.ads deleted file mode 100644 index 66ec2a1cc..000000000 --- a/evaluation.ads +++ /dev/null @@ -1,161 +0,0 @@ --- Evaluation of static expressions. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Types; use Types; -with Iirs; use Iirs; - -package Evaluation is - - -- Evaluation is about compile-time computation of expressions, such as - -- 2 + 1 --> 3. This is (of course) possible only with locally (and some - -- globally) static expressions. Evaluation is required during semantic - -- analysis at many places (in fact those where locally static expression - -- are required by the language). For example, the type of O'Range (N) - -- depends on N, so we need to evaluate N. - -- - -- The result of evaluation is a literal (integer, enumeration, real, - -- physical), a string or a simple aggregate. For scalar types, the - -- result is therefore normalized (there is only one kind of result), but - -- for array types, the result isn't: in general it will be a string, but - -- it may be a simple aggregate. Strings are preferred (because they are - -- more compact), but aren't possible in some cases. For example, the - -- evaluation of "Text" & NUL cannot be a string. - -- - -- Some functions (like Eval_Static_Expr) simply returns a result (which - -- may be a node of the expression), others returns a result and set the - -- origin (Literal_Origin or Range_Origin) to remember the original - -- expression that was evaluation. The original expression is kept so that - -- it is possible to print the original tree. - - -- Get the value of a physical integer literal or unit. - function Get_Physical_Value (Expr : Iir) return Iir_Int64; - - -- Evaluate the locally static expression EXPR (without checking that EXPR - -- is locally static). Return a literal or an aggregate, without setting - -- the origin, and do not modify EXPR. This can be used only to get the - -- value of an expression, without replacing it. - function Eval_Static_Expr (Expr: Iir) return Iir; - - -- Evaluate (ie compute) expression EXPR. - -- EXPR is required to be a locally static expression, otherwise an error - -- message is generated. - -- The result is a literal with the origin set. - function Eval_Expr (Expr: Iir) return Iir; - - -- Same as Eval_Expr, but if EXPR is not locally static, the result is - -- EXPR. Also, if EXPR is null_iir, then null_iir is returned. - -- The purpose of this function is to evaluate an expression only if it - -- is locally static. - function Eval_Expr_If_Static (Expr : Iir) return Iir; - - -- Evaluate a physical literal and return a normalized literal (using - -- the primary unit as unit). - function Eval_Physical_Literal (Expr : Iir) return Iir; - - -- Return TRUE if literal EXPR is in SUB_TYPE bounds. - function Eval_Is_In_Bound (Expr : Iir; Sub_Type : Iir) return Boolean; - - -- Emit an error if EXPR violates SUB_TYPE bounds. - procedure Eval_Check_Bound (Expr : Iir; Sub_Type : Iir); - - -- Same as Eval_Expr, but a range check with SUB_TYPE is performed after - -- computation. - function Eval_Expr_Check (Expr : Iir; Sub_Type : Iir) return Iir; - - -- Call Eval_Expr_Check only if EXPR is static. - function Eval_Expr_Check_If_Static (Expr : Iir; Atype : Iir) return Iir; - - -- For a locally static range RNG (a range expression, a range attribute - -- or a name that denotes a type or a subtype) returns its corresponding - -- locally static range_expression. The bounds of the results are also - -- literals. - -- Return a range_expression or NULL_IIR for a non locally static range. - function Eval_Static_Range (Rng : Iir) return Iir; - - -- Return a locally static range expression with the origin set for ARANGE. - function Eval_Range (Arange : Iir) return Iir; - - -- If ARANGE is a locally static range, return locally static range - -- expression (with the origin set), else return ARANGE. - function Eval_Range_If_Static (Arange : Iir) return Iir; - - -- Emit an error if A_RANGE is not included in SUB_TYPE. A_RANGE can be - -- a range expression, a range attribute or a name that denotes a discrete - -- type or subtype. A_RANGE must be a locally static range. - procedure Eval_Check_Range (A_Range : Iir; Sub_Type : Iir; - Any_Dir : Boolean); - - -- Return TRUE if range expression A_RANGE is not included in SUB_TYPE. - function Eval_Is_Range_In_Bound - (A_Range : Iir; Sub_Type : Iir; Any_Dir : Boolean) - return Boolean; - - -- Return TRUE iff VAL belongs to BOUND. - function Eval_Int_In_Range (Val : Iir_Int64; Bound : Iir) return Boolean; - - -- Return the length of the discrete range CONSTRAINT. - function Eval_Discrete_Range_Length (Constraint : Iir) return Iir_Int64; - - -- Return the length of SUB_TYPE. - function Eval_Discrete_Type_Length (Sub_Type : Iir) return Iir_Int64; - - -- Get the left bound of a range constraint. - -- Note: the range constraint may be an attribute or a subtype. - function Eval_Discrete_Range_Left (Constraint : Iir) return Iir; - - -- Return the position of EXPR, ie the result of sub_type'pos (EXPR), where - -- sub_type is the type of expr. - -- EXPR must be of a discrete subtype. - function Eval_Pos (Expr : Iir) return Iir_Int64; - - -- Replace ORIGIN (an overflow literal) with extreme positive value (if - -- IS_POS is true) or extreme negative value. - function Build_Extreme_Value (Is_Pos : Boolean; Origin : Iir) return Iir; - - -- Create an array subtype from LEN and BASE_TYPE, according to rules - -- of LRM93 7.3.2.2. (which are the same as LRM93 7.2.4). - function Create_Unidim_Array_By_Length - (Base_Type : Iir; Len : Iir_Int64; Loc : Iir) - return Iir_Array_Subtype_Definition; - - -- Create a subtype of A_TYPE whose length is LEN. - -- This is used to create subtypes for strings or aggregates. - function Create_Range_Subtype_By_Length - (A_Type : Iir; Len : Iir_Int64; Loc : Location_Type) - return Iir; - - -- Store into NAME_BUFFER, NAME_LENGTH the simple name, character literal - -- or operator sumbol of ID, using the same format as SIMPLE_NAME - -- attribute. - procedure Eval_Simple_Name (Id : Name_Id); - - -- Compare two string literals (of same length). - type Compare_Type is (Compare_Lt, Compare_Eq, Compare_Gt); - function Compare_String_Literals (L, R : Iir) return Compare_Type; - - -- Return the local part of 'Instance_Name or 'Path_Name. - type Path_Instance_Name_Type (Len : Natural) is record - -- The node before suffix (entity, architecture or generate iterator). - Path_Instance : Iir; - - -- The suffix - Suffix : String (1 .. Len); - end record; - - function Get_Path_Instance_Name_Suffix (Attr : Iir) - return Path_Instance_Name_Type; -end Evaluation; diff --git a/files_map.adb b/files_map.adb deleted file mode 100644 index f4927e8db..000000000 --- a/files_map.adb +++ /dev/null @@ -1,857 +0,0 @@ --- Loading of source files. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Interfaces.C; -with Ada.Characters.Latin_1; -with Ada.Text_IO; use Ada.Text_IO; -with Ada.Unchecked_Deallocation; -with GNAT.Table; -with GNAT.OS_Lib; -with GNAT.Directory_Operations; -with Name_Table; use Name_Table; -with Str_Table; -with Ada.Calendar; -with Ada.Calendar.Time_Zones; - -package body Files_Map is - - -- Check validity of FILE. - -- Raise an exception in case of error. - procedure Check_File (File: in Source_File_Entry); - - type Lines_Table_Type is array (Positive) of Source_Ptr; - type Lines_Table_Ptr is access all Lines_Table_Type; - - -- Data associed with a file. - type Source_File_Record is record - -- All location between first and last belong to this file. - First_Location : Location_Type; - Last_Location : Location_Type; - - -- The name_id that identify this file. - -- FIXME: what about file aliasing (links) ? - File_Name: Name_Id; - - Directory : Name_Id; - - -- The buffer containing the file. - Source: File_Buffer_Acc; - - -- Length of the file, which is also the length of the buffer. - File_Length: Natural; - - Time_Stamp: Time_Stamp_Id; - - -- Current number of line in Lines_Table. - Nbr_Lines: Natural; - - Lines_Table: Lines_Table_Ptr; - - -- Current size of Lines_Table. - Lines_Table_Max: Natural; - - -- Cache. - Cache_Line : Natural; - Cache_Pos : Source_Ptr; - end record; - - -- Next location to use. - Next_Location : Location_Type := Location_Nil + 1; - - package Source_Files is new GNAT.Table - (Table_Index_Type => Source_File_Entry, - Table_Component_Type => Source_File_Record, - Table_Low_Bound => No_Source_File_Entry + 1, - Table_Initial => 16, - Table_Increment => 100); - - function Get_Last_Source_File_Entry return Source_File_Entry is - begin - return Source_Files.Last; - end Get_Last_Source_File_Entry; - - Home_Dir : Name_Id := Null_Identifier; - - function Get_Home_Directory return Name_Id is - begin - if Home_Dir = Null_Identifier then - GNAT.Directory_Operations.Get_Current_Dir (Name_Buffer, Name_Length); - Home_Dir := Get_Identifier; - end if; - return Home_Dir; - end Get_Home_Directory; - - procedure Location_To_File_Pos (Location : Location_Type; - File : out Source_File_Entry; - Pos : out Source_Ptr) - is - begin - -- FIXME: use a cache - -- FIXME: dicotomy - for I in Source_Files.First .. Source_Files.Last loop - declare - F : Source_File_Record renames Source_Files.Table (I); - begin - if Location >= F.First_Location - and then Location <= F.Last_Location - then - File := I; - Pos := Source_Ptr (Location - F.First_Location); - return; - end if; - end; - end loop; - -- File not found, location must be bad... - raise Internal_Error; - end Location_To_File_Pos; - - function File_Pos_To_Location (File : Source_File_Entry; Pos : Source_Ptr) - return Location_Type - is - begin - if Source_Files.Table (File).Source = null then - raise Internal_Error; - else - return Source_Files.Table (File).First_Location + Location_Type (Pos); - end if; - end File_Pos_To_Location; - - function Source_File_To_Location (File : Source_File_Entry) - return Location_Type - is - begin - return Source_Files.Table (File).First_Location; - end Source_File_To_Location; - - procedure Reallocate_Lines_Table - (File: in out Source_File_Record; New_Size: Natural) is - use Interfaces.C; - - function realloc - (memblock : Lines_Table_Ptr; - size : size_t) - return Lines_Table_Ptr; - pragma Import (C, realloc); - - function malloc - (size : size_t) - return Lines_Table_Ptr; - pragma Import (C, malloc); - - New_Table: Lines_Table_Ptr; - New_Byte_Size : size_t; - begin - New_Byte_Size := - size_t(New_Size * - Lines_Table_Type'Component_Size / System.Storage_Unit); - if File.Lines_Table = null then - New_Table := malloc (New_Byte_Size); - else - New_Table := realloc (File.Lines_Table, New_Byte_Size); - end if; - if New_Table = null then - raise Storage_Error; - else - File.Lines_Table := New_Table; - File.Lines_Table (File.Lines_Table_Max + 1 .. New_Size) := - (others => Source_Ptr_Bad); - File.Lines_Table_Max := New_Size; - end if; - end Reallocate_Lines_Table; - - -- Add a new entry in the lines_table. - -- The new entry must be the next one after the last entry. - procedure File_Add_Line_Number - (File: Source_File_Entry; Line: Natural; Pos: Source_Ptr) is - Source_File: Source_File_Record renames Source_Files.Table (File); - begin - -- Just check File is not out of bounds. - if File > Source_Files.Last then - raise Internal_Error; - end if; - - if Line = 1 then - -- The position of the first line is well-known. - if Pos /= Source_Ptr_Org then - raise Internal_Error; - end if; - else - -- The position of a non first line is not the well-known value. - if Pos <= Source_Ptr_Org then - raise Internal_Error; - end if; - -- Take care of scan backtracking. - if Line <= Source_File.Nbr_Lines then - if Source_File.Lines_Table (Line) = Source_Ptr_Bad then - Source_File.Lines_Table (Line) := Pos; - elsif Pos /= Source_File.Lines_Table (Line) then - Put_Line ("file" & Source_File_Entry'Image (File) - & " for line" & Natural'Image (Line) - & " pos =" & Source_Ptr'Image (Pos) - & ", lines_table = " - & Source_Ptr'Image (Source_File.Lines_Table (Line))); - raise Internal_Error; - end if; - return; - end if; - -- The new entry must just follow the last entry. --- if Line /= Source_File.Nbr_Lines + 1 then --- raise Internal_Error; --- end if; - end if; - if Line > Source_File.Lines_Table_Max then - Reallocate_Lines_Table (Source_File, (Line / 128 + 1) * 128); - end if; - Source_File.Lines_Table (Line) := Pos; - if Line > Source_File.Nbr_Lines then - Source_File.Nbr_Lines := Line; - end if; - -- Source_File.Nbr_Lines := Source_File.Nbr_Lines + 1; - if False then - Put_Line ("file" & Source_File_Entry'Image (File) - & " line" & Natural'Image (Line) - & " at position" & Source_Ptr'Image (Pos)); - end if; - end File_Add_Line_Number; - - -- Convert a physical column to a logical column. - -- A physical column is the offset in byte from the first byte of the line. - -- A logical column is the position of the character when displayed. - -- A HT (tabulation) moves the cursor to the next position multiple of 8. - -- The first character is at position 1 and at offset 0. - procedure Coord_To_Position - (File : Source_File_Entry; - Line_Pos : Source_Ptr; - Offset : Natural; - Name : out Name_Id; - Col : out Natural) - is - Source_File: Source_File_Record renames Source_Files.Table (File); - Res : Positive := 1; - begin - Name := Source_File.File_Name; - for I in Line_Pos .. Line_Pos + Source_Ptr (Offset) - 1 loop - if Source_File.Source (I) = Ada.Characters.Latin_1.HT then - Res := Res + 8 - Res mod 8; - else - Res := Res + 1; - end if; - end loop; - Col := Res; - end Coord_To_Position; - - -- Should only be called by Location_To_Coord. - function Location_To_Line - (Source_File : Source_File_Record; Pos : Source_Ptr) - return Natural - is - Low, Hi, Mid : Natural; - Mid1 : Natural; - Lines_Table : constant Lines_Table_Ptr := Source_File.Lines_Table; - begin - -- Look in the cache. - if Pos >= Source_File.Cache_Pos then - Low := Source_File.Cache_Line; - Hi := Source_File.Nbr_Lines; - else - Low := 1; - Hi := Source_File.Cache_Line; - end if; - - loop - << Again >> null; - Mid := (Hi + Low) / 2; - if Lines_Table (Mid) = Source_Ptr_Bad then - -- There is a hole: no position for this line. - -- Set MID1 to a line which has a position. - -- Try downward. - Mid1 := Mid; - while Lines_Table (Mid1) = Source_Ptr_Bad loop - -- Note: Low may have no line. - exit when Mid1 = Low; - Mid1 := Mid1 - 1; - end loop; - if Mid1 /= Low then - -- Mid1 has a line. - if Pos < Lines_Table (Mid1) then - Hi := Mid1; - goto Again; - end if; - if Pos > Lines_Table (Mid1) then - Low := Mid1; - goto Again; - end if; - -- Found, handled just below. - else - -- Failed (downward is LOW): try upward. - Mid1 := Mid; - while Lines_Table (Mid1) = Source_Ptr_Bad loop - Mid1 := Mid1 + 1; - end loop; - if Mid1 = Hi then - -- Failed: no lines between LOW and HI. - if Pos >= Lines_Table (Hi) then - Mid1 := Hi; - else - Mid1 := Low; - end if; - return Mid1; - end if; - -- Mid1 has a line. - if Pos < Lines_Table (Mid1) then - Hi := Mid1; - goto Again; - end if; - if Pos > Lines_Table (Mid1) then - Low := Mid1; - goto Again; - end if; - end if; - Mid := Mid1; - end if; - if Pos >= Lines_Table (Mid) then - if Mid = Source_File.Nbr_Lines - or else Pos < Lines_Table (Mid + 1) - or else Pos = Lines_Table (Mid) - or else (Hi <= Mid + 1 - and Lines_Table (Mid + 1) = Source_Ptr_Bad) - then - return Mid; - end if; - end if; - if Pos < Lines_Table (Mid) then - Hi := Mid - 1; - else - if Lines_Table (Mid + 1) /= Source_Ptr_Bad then - Low := Mid + 1; - else - Low := Mid; - end if; - end if; - end loop; - end Location_To_Line; - - procedure Location_To_Coord - (Source_File : in out Source_File_Record; - Pos : Source_Ptr; - Line_Pos : out Source_Ptr; - Line : out Natural; - Offset : out Natural) - is - Line_P : Source_Ptr; - Line_Threshold : constant Natural := 4; - Low, Hi : Natural; - begin - -- Look in the cache. - if Pos >= Source_File.Cache_Pos then - Low := Source_File.Cache_Line; - Hi := Source_File.Nbr_Lines; - - -- Maybe adjust the threshold. - -- Quick look. - if Pos - Source_File.Cache_Pos <= 120 - and then Low + Line_Threshold <= Hi - then - for I in 1 .. Line_Threshold loop - Line_P := Source_File.Lines_Table (Low + I); - if Line_P > Pos then - Line := Low + I - 1; - goto Found; - else - exit when Line_P = Source_Ptr_Bad; - end if; - end loop; - end if; - end if; - - Line := Location_To_Line (Source_File, Pos); - - << Found >> null; - - Line_Pos := Source_File.Lines_Table (Line); - Offset := Natural (Pos - Source_File.Lines_Table (Line)); - - -- Update cache. - Source_File.Cache_Pos := Pos; - Source_File.Cache_Line := Line; - end Location_To_Coord; - - procedure Location_To_Position - (Location : Location_Type; - Name : out Name_Id; - Line : out Natural; - Col : out Natural) - is - File : Source_File_Entry; - Line_Pos : Source_Ptr; - Offset : Natural; - begin - Location_To_Coord (Location, File, Line_Pos, Line, Offset); - Coord_To_Position (File, Line_Pos, Offset, Name, Col); - end Location_To_Position; - - procedure Location_To_Coord - (Location : Location_Type; - File : out Source_File_Entry; - Line_Pos : out Source_Ptr; - Line : out Natural; - Offset : out Natural) - is - Pos : Source_Ptr; - begin - Location_To_File_Pos (Location, File, Pos); - Location_To_Coord (Source_Files.Table (File), Pos, - Line_Pos, Line, Offset); - end Location_To_Coord; - - -- Convert the first digit of VAL into a character (base 10). - function Digit_To_Char (Val: Natural) return Character is - begin - return Character'Val (Character'Pos ('0') + Val mod 10); - end Digit_To_Char; - - -- Format: YYYYMMDDHHmmsscc - -- Y: year, M: month, D: day, H: hour, m: minute, s: second, cc:100th sec - function Os_Time_To_Time_Stamp_Id (Time: GNAT.OS_Lib.OS_Time) - return Time_Stamp_Id - is - use GNAT.OS_Lib; - use Str_Table; - Res: Time_Stamp_Id; - Year: Year_Type; - Month: Month_Type; - Day: Day_Type; - Hour: Hour_Type; - Minute: Minute_Type; - Second: Second_Type; - begin - GM_Split (Time, Year, Month, Day, Hour, Minute, Second); - Res := Time_Stamp_Id (Start); - Append (Digit_To_Char (Year / 1000)); - Append (Digit_To_Char (Year / 100)); - Append (Digit_To_Char (Year / 10)); - Append (Digit_To_Char (Year / 1)); - Append (Digit_To_Char (Month / 10)); - Append (Digit_To_Char (Month / 1)); - Append (Digit_To_Char (Day / 10)); - Append (Digit_To_Char (Day / 1)); - Append (Digit_To_Char (Hour / 10)); - Append (Digit_To_Char (Hour / 1)); - Append (Digit_To_Char (Minute / 10)); - Append (Digit_To_Char (Minute / 1)); - Append (Digit_To_Char (Second / 10)); - Append (Digit_To_Char (Second / 1)); - Append ('.'); - Append ('0'); - Append ('0'); - Append ('0'); - Finish; - return Res; - end Os_Time_To_Time_Stamp_Id; - - function Get_File_Time_Stamp (Filename : System.Address) - return Time_Stamp_Id - is - use GNAT.OS_Lib; - Fd : File_Descriptor; - Res : Time_Stamp_Id; - begin - Fd := Open_Read (Filename, Binary); - if Fd = Invalid_FD then - return Null_Time_Stamp; - end if; - Res := Os_Time_To_Time_Stamp_Id (File_Time_Stamp (Fd)); - Close (Fd); - return Res; - end Get_File_Time_Stamp; - - function Get_File_Time_Stamp (FD : GNAT.OS_Lib.File_Descriptor) - return Time_Stamp_Id - is - begin - return Os_Time_To_Time_Stamp_Id (GNAT.OS_Lib.File_Time_Stamp (FD)); - end Get_File_Time_Stamp; - - function Get_Os_Time_Stamp return Time_Stamp_Id - is - use Ada.Calendar; - use Ada.Calendar.Time_Zones; - use Str_Table; - - Now : constant Time := Clock; - Now_UTC : constant Time := Now - Duration (UTC_Time_Offset (Now) * 60); - Year : Year_Number; - Month : Month_Number; - Day : Day_Number; - Sec : Day_Duration; - S : Integer; - S1 : Integer; - M : Integer; - Res: Time_Stamp_Id; - begin - -- Use UTC time (like file time stamp). - Split (Now_UTC, Year, Month, Day, Sec); - - Res := Time_Stamp_Id (Start); - Append (Digit_To_Char (Year / 1000)); - Append (Digit_To_Char (Year / 100)); - Append (Digit_To_Char (Year / 10)); - Append (Digit_To_Char (Year / 1)); - Append (Digit_To_Char (Month / 10)); - Append (Digit_To_Char (Month / 1)); - Append (Digit_To_Char (Day / 10)); - Append (Digit_To_Char (Day / 1)); - S := Integer (Sec); - if Day_Duration (S) > Sec then - -- We need a truncation. - S := S - 1; - end if; - S1 := S / 3600; - Append (Digit_To_Char (S1 / 10)); - Append (Digit_To_Char (S1)); - S1 := (S / 60) mod 60; - Append (Digit_To_Char (S1 / 10)); - Append (Digit_To_Char (S1)); - S1 := S mod 60; - Append (Digit_To_Char (S1 / 10)); - Append (Digit_To_Char (S1)); - - Append ('.'); - Sec := Sec - Day_Duration (S); - M := Integer (Sec * 1000); - if M = 1000 then - -- We need truncation. - M := 999; - end if; - Append (Digit_To_Char (M / 100)); - Append (Digit_To_Char (M / 10)); - Append (Digit_To_Char (M)); - Finish; - return Res; - end Get_Os_Time_Stamp; - - function Get_Pathname (Directory : Name_Id; - Name: Name_Id; - Add_Nul : Boolean) - return String - is - L : Natural; - begin - Image (Name); - if not GNAT.OS_Lib.Is_Absolute_Path (Name_Buffer (1 .. Name_Length)) then - L := Name_Length; - Image (Directory); - Name_Buffer (Name_Length + 1 .. Name_Length + L) := Image (Name); - Name_Length := Name_Length + L; - end if; - if Add_Nul then - Name_Length := Name_Length + 1; - Name_Buffer (Name_Length) := Character'Val (0); - end if; - return Name_Buffer (1 .. Name_Length); - end Get_Pathname; - - -- Find a source_file by DIRECTORY and NAME. - -- Return NO_SOURCE_FILE_ENTRY if not already opened. - function Find_Source_File (Directory : Name_Id; Name: Name_Id) - return Source_File_Entry - is - begin - for I in Source_Files.First .. Source_Files.Last loop - if Source_Files.Table (I).File_Name = Name - and then Source_Files.Table (I).Directory = Directory - then - return I; - end if; - end loop; - return No_Source_File_Entry; - end Find_Source_File; - - -- Return an entry for a filename. - -- The file is not loaded. - function Create_Source_File_Entry (Directory : Name_Id; Name: Name_Id) - return Source_File_Entry - is - Res: Source_File_Entry; - begin - if Find_Source_File (Directory, Name) /= No_Source_File_Entry then - raise Internal_Error; - end if; - - -- Create a new entry. - Res := Source_Files.Allocate; - Source_Files.Table (Res) := (First_Location => Next_Location, - Last_Location => Next_Location, - File_Name => Name, - Directory => Directory, - Time_Stamp => Null_Time_Stamp, - Source => null, - File_Length => 0, - Nbr_Lines => 0, - Lines_Table_Max => 0, - Lines_Table => null, - Cache_Pos => Source_Ptr_Org, - Cache_Line => 1); - File_Add_Line_Number (Res, 1, Source_Ptr_Org); - return Res; - end Create_Source_File_Entry; - - function Create_Source_File_From_String (Name: Name_Id; Content : String) - return Source_File_Entry - is - Res : Source_File_Entry; - Buffer: File_Buffer_Acc; - Len : constant Source_Ptr := Source_Ptr (Content'Length); - begin - Res := Create_Source_File_Entry (Null_Identifier, Name); - - Buffer := new File_Buffer - (Source_Ptr_Org .. Source_Ptr_Org + Len + 1); - - Buffer (Source_Ptr_Org .. Source_Ptr_Org + Len - 1) := - File_Buffer (Content); - Buffer (Source_Ptr_Org + Len) := EOT; - Buffer (Source_Ptr_Org + Len + 1) := EOT; - - Source_Files.Table (Res).Last_Location := - Next_Location + Location_Type (Len) + 1; - Next_Location := Source_Files.Table (Res).Last_Location + 1; - Source_Files.Table (Res).Source := Buffer; - Source_Files.Table (Res).File_Length := Natural (Len); - - return Res; - end Create_Source_File_From_String; - - function Create_Virtual_Source_File (Name: Name_Id) - return Source_File_Entry - is - begin - return Create_Source_File_From_String (Name, ""); - end Create_Virtual_Source_File; - - -- Return an entry for a filename. - -- Load the filename if necessary. - function Load_Source_File (Directory : Name_Id; Name: Name_Id) - return Source_File_Entry - is - use GNAT.OS_Lib; - Fd: File_Descriptor; - - Res: Source_File_Entry; - - Length: Source_Ptr; - Buffer: File_Buffer_Acc; - begin - -- If the file is already loaded, nothing to do! - Res := Find_Source_File (Directory, Name); - if Res /= No_Source_File_Entry then - if Source_Files.Table (Res).Source = null then - raise Internal_Error; - end if; - return Res; - end if; - - -- Open the file (punt on non regular files). - declare - Filename : String := Get_Pathname (Directory, Name, True); - begin - if not Is_Regular_File(Filename) then - return No_Source_File_Entry; - end if; - Fd := Open_Read (Filename'Address, Binary); - if Fd = Invalid_FD then - return No_Source_File_Entry; - end if; - end; - - Res := Create_Source_File_Entry (Directory, Name); - - Source_Files.Table (Res).Time_Stamp := Get_File_Time_Stamp (Fd); - - Length := Source_Ptr (File_Length (Fd)); - - Buffer := - new File_Buffer (Source_Ptr_Org .. Source_Ptr_Org + Length + 1); - - if Read (Fd, Buffer (Source_Ptr_Org)'Address, Integer (Length)) - /= Integer (Length) - then - Close (Fd); - raise Internal_Error; - end if; - Buffer (Length) := EOT; - Buffer (Length + 1) := EOT; - - if Source_Files.Table (Res).First_Location /= Next_Location then - -- Load_Source_File call must follow its Create_Source_File. - raise Internal_Error; - end if; - - Source_Files.Table (Res).Last_Location := - Next_Location + Location_Type (Length) + 1; - Next_Location := Source_Files.Table (Res).Last_Location + 1; - Source_Files.Table (Res).Source := Buffer; - Source_Files.Table (Res).File_Length := Integer (Length); - - Close (Fd); - - return Res; - end Load_Source_File; - - -- Check validity of FILE. - -- Raise an exception in case of error. - procedure Check_File (File: in Source_File_Entry) is - begin - if File > Source_Files.Last then - raise Internal_Error; - end if; - end Check_File; - - -- Return a buffer (access to the contents of the file) for a file entry. - function Get_File_Source (File: Source_File_Entry) - return File_Buffer_Acc is - begin - Check_File (File); - return Source_Files.Table (File).Source; - end Get_File_Source; - - -- Return the length of the file (which is the size of the file buffer). - function Get_File_Length (File: Source_File_Entry) return Source_Ptr is - begin - Check_File (File); - return Source_Ptr (Source_Files.Table (File).File_Length); - end Get_File_Length; - - -- Return the name of the file. - function Get_File_Name (File: Source_File_Entry) return Name_Id is - begin - Check_File (File); - return Source_Files.Table (File).File_Name; - end Get_File_Name; - - -- Return the date of the file (last modification date) as a string. - function Get_File_Time_Stamp (File: Source_File_Entry) - return Time_Stamp_Id is - begin - Check_File (File); - return Source_Files.Table (File).Time_Stamp; - end Get_File_Time_Stamp; - - function Get_Source_File_Directory (File : Source_File_Entry) - return Name_Id is - begin - Check_File (File); - return Source_Files.Table (File).Directory; - end Get_Source_File_Directory; - - function Line_To_Position (File : Source_File_Entry; Line : Natural) - return Source_Ptr - is - begin - Check_File (File); - if Line > Source_Files.Table (File).Nbr_Lines then - return Source_Ptr_Bad; - else - return Source_Files.Table (File).Lines_Table (Line); - end if; - end Line_To_Position; - - function Is_Eq (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean - is - use Str_Table; - L_Str : constant String_Fat_Acc := Get_String_Fat_Acc (String_Id (L)); - R_Str : constant String_Fat_Acc := Get_String_Fat_Acc (String_Id (R)); - begin - return L_Str (1 .. Time_Stamp_String'Length) - = R_Str (1 .. Time_Stamp_String'Length); - end Is_Eq; - - function Is_Gt (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean - is - use Str_Table; - L_Str : constant String_Fat_Acc := Get_String_Fat_Acc (String_Id (L)); - R_Str : constant String_Fat_Acc := Get_String_Fat_Acc (String_Id (R)); - begin - return L_Str (1 .. Time_Stamp_String'Length) - > R_Str (1 .. Time_Stamp_String'Length); - end Is_Gt; - - function Get_Time_Stamp_String (Ts : Time_Stamp_Id) return String is - begin - if Ts = Null_Time_Stamp then - return "NULL_TS"; - else - return String (Str_Table.Get_String_Fat_Acc (String_Id (Ts)) - (1 .. Time_Stamp_String'Length)); - end if; - end Get_Time_Stamp_String; - - -- Debug procedures. - procedure Debug_Source_Lines (File: Source_File_Entry); - pragma Unreferenced (Debug_Source_Lines); - - procedure Debug_Source_File; - pragma Unreferenced (Debug_Source_File); - - -- Disp sources lines of a file. - procedure Debug_Source_Lines (File: Source_File_Entry) is - Source_File: Source_File_Record renames Source_Files.Table (File); - begin - Check_File (File); - for I in Positive'First .. Source_File.Nbr_Lines loop - Put_Line ("line" & Natural'Image (I) & " at offset" - & Source_Ptr'Image (Source_File.Lines_Table (I))); - end loop; - end Debug_Source_Lines; - - procedure Debug_Source_File is - begin - for I in Source_Files.First .. Source_Files.Last loop - declare - F : Source_File_Record renames Source_Files.Table(I); - begin - Put ("file" & Source_File_Entry'Image (I)); - Put (" name: " & Image (F.File_Name)); - Put (" dir:" & Image (F.Directory)); - Put (" length:" & Natural'Image (F.File_Length)); - New_Line; - if F.Time_Stamp /= Null_Time_Stamp then - Put (" time_stamp: " & Get_Time_Stamp_String (F.Time_Stamp)); - end if; - Put (" nbr lines:" & Natural'Image (F.Nbr_Lines)); - Put (" lines_table_max:" & Natural'Image (F.Lines_Table_Max)); - New_Line; - end; - end loop; - end Debug_Source_File; - - procedure Initialize - is - procedure free (Ptr : Lines_Table_Ptr); - pragma Import (C, free); - - procedure Free is new Ada.Unchecked_Deallocation - (File_Buffer, File_Buffer_Acc); - begin - for I in Source_Files.First .. Source_Files.Last loop - free (Source_Files.Table (I).Lines_Table); - Free (Source_Files.Table (I).Source); - end loop; - Source_Files.Free; - Source_Files.Init; - end Initialize; -end Files_Map; diff --git a/files_map.ads b/files_map.ads deleted file mode 100644 index c360995c3..000000000 --- a/files_map.ads +++ /dev/null @@ -1,152 +0,0 @@ --- Loading of source files. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Types; use Types; -with System; - -package Files_Map is - - -- Source file handling - ----------------------- - - -- Create the path from DIRECTORY and NAME: - -- If NAME is an absolute pathname, then return NAME. - -- Otherwise, return the concatenation of DIRECTORY and NAME. - -- If ADD_NUL is TRUE, then a trailing '\0' is appended. - function Get_Pathname (Directory : Name_Id; - Name: Name_Id; - Add_Nul : Boolean) - return String; - - -- Return an entry for a filename. - -- Load the filename if necessary. - -- Return No_Source_File_Entry if the file does not exist. - function Load_Source_File (Directory : Name_Id; Name: Name_Id) - return Source_File_Entry; - - -- Each file in memory has two terminal EOT. - EOT : constant Character := Character'Val (4); - - -- Create a Source_File for a virtual file name. Used for implicit, - -- command-line and std.standard library. - function Create_Virtual_Source_File (Name: Name_Id) - return Source_File_Entry; - - -- Create a Source_File for a possible virtual file NAME using CONTENT - -- as content of the file. The file must not already exist. - function Create_Source_File_From_String (Name: Name_Id; Content : String) - return Source_File_Entry; - - -- Return a buffer (access to the contents of the file) for a file entry. - function Get_File_Source (File: Source_File_Entry) - return File_Buffer_Acc; - - -- Return the length of the file (which is the size of the file buffer). - function Get_File_Length (File: Source_File_Entry) return Source_Ptr; - - -- Return the entry of the last known file. - -- This allow the user to create a table of Source_File_Entry. - function Get_Last_Source_File_Entry return Source_File_Entry; - - -- Time stamp handling. - function Is_Eq (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean; - function Is_Gt (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean; - function Get_Time_Stamp_String (Ts : Time_Stamp_Id) return String; - - -- Return the date of the file (last modification date) as a string. - function Get_File_Time_Stamp (File: Source_File_Entry) - return Time_Stamp_Id; - function Get_File_Time_Stamp (Filename : System.Address) - return Time_Stamp_Id; - - -- Return the current date of the system. - function Get_Os_Time_Stamp return Time_Stamp_Id; - - -- Return the home directory (current directory). - function Get_Home_Directory return Name_Id; - - -- Return the directory of the file. - function Get_Source_File_Directory (File : Source_File_Entry) - return Name_Id; - - -- Return the name of the file. - function Get_File_Name (File: Source_File_Entry) return Name_Id; - - -- Get the path of directory DIR. - --function Get_Directory_Path (Dir : Directory_Index) return String; - - -- Add a new entry in the lines_table. - -- The new entry must be the next one after the last entry. - procedure File_Add_Line_Number - (File: Source_File_Entry; Line: Natural; Pos: Source_Ptr); - - -- Convert LOCATION into a source file FILE and an offset POS in the - -- file. - procedure Location_To_File_Pos (Location : Location_Type; - File : out Source_File_Entry; - Pos : out Source_Ptr); - -- Convert a FILE and an offset POS in the file into a location. - function File_Pos_To_Location (File : Source_File_Entry; Pos : Source_Ptr) - return Location_Type; - -- Convert a FILE into a location. - function Source_File_To_Location (File : Source_File_Entry) - return Location_Type; - - -- Convert a FILE+LINE into a position. - -- Return Source_Ptr_Bad in case of error (LINE out of bounds). - function Line_To_Position (File : Source_File_Entry; Line : Natural) - return Source_Ptr; - - -- Translate LOCATION into coordinate (physical position). - -- FILE identifies the filename. - -- LINE_POS is the offset in the file of the first character of the line, - -- LINE is the line number (first line is 1), - -- OFFSET is the offset of the location in the line (first character is 0, - -- a tabulation is one character), - procedure Location_To_Coord - (Location : Location_Type; - File : out Source_File_Entry; - Line_Pos : out Source_Ptr; - Line : out Natural; - Offset : out Natural); - - -- Translate coordinate into logical position. - -- NAME is the name of the file, - -- COL is the column (first character is 1, tabulation are at every 8 - -- positions). - procedure Coord_To_Position - (File : Source_File_Entry; - Line_Pos : Source_Ptr; - Offset : Natural; - Name : out Name_Id; - Col : out Natural); - - -- Translate LOCATION to NAME, LINE and COL. - -- It is like to two procedures above. - procedure Location_To_Position - (Location : Location_Type; - Name : out Name_Id; - Line : out Natural; - Col : out Natural); - - -- Get LINE and COL from LOCATION. - --procedure Get_Source_File_Line_And_Column - -- (Location: Location_Type; Line, Col: out Natural; Name : out Name_Id); - - -- Free all memory and reinitialize. - procedure Initialize; -end Files_Map; diff --git a/flags.adb b/flags.adb deleted file mode 100644 index fc00368a5..000000000 --- a/flags.adb +++ /dev/null @@ -1,53 +0,0 @@ --- Global flags. --- Copyright (C) 2002, 2003, 2004, 2005, 2008 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -package body Flags is - procedure Create_Flag_String is - begin - case Vhdl_Std is - when Vhdl_87 => - Flag_String (1 .. 2) := "87"; - when Vhdl_93c - | Vhdl_93 - | Vhdl_00 - | Vhdl_02 => - Flag_String (1 .. 2) := "93"; - when Vhdl_08 => - Flag_String (1 .. 2) := "08"; - end case; - if Flag_Integer_64 then - Flag_String (3) := 'I'; - else - Flag_String (3) := 'i'; - end if; - if Flag_Time_64 then - Flag_String (4) := 'T'; - else - Flag_String (4) := 't'; - end if; - if not Flag_Time_64 and Vhdl_Std = Vhdl_87 then - Flag_String (5) := Time_Resolution; - else - if Flag_Time_64 then - Flag_String (5) := '-'; - else - Flag_String (5) := '?'; - end if; - end if; - end Create_Flag_String; -end Flags; diff --git a/flags.ads b/flags.ads deleted file mode 100644 index 03e9fe959..000000000 --- a/flags.ads +++ /dev/null @@ -1,190 +0,0 @@ --- Global flags. --- Copyright (C) 2002, 2003, 2004, 2005, 2008 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - --- All the variables declared in this package are set by Parse_Option function --- and can by read as soon as the command line is parsed. --- --- Since the names are not prefixed, this package is expected to be with'ed --- but not to be use'd. - -package Flags is - -- List of vhdl standards. - -- VHDL_93c is vhdl_93 with backward compatibility with 87 (file). - type Vhdl_Std_Type is - (Vhdl_87, Vhdl_93c, Vhdl_93, Vhdl_00, Vhdl_02, Vhdl_08); - - -- Standard accepted. - Vhdl_Std: Vhdl_Std_Type := Vhdl_93c; - - -- Enable AMS-VHDL extensions. - AMS_Vhdl : Boolean := False; - - -- Some flags (such as vhdl version) must be the same for every design - -- units of a hierarchy. - -- The Flag_String is a signature of all these flags. - Flag_String : String (1 .. 5); - procedure Create_Flag_String; - - -- If set, a multi-bytes sequence can appear in a comment, ie, all - -- characters except VT, CR, LF and FF are allowed in a comment. - -- Set by -C and --mb-comments - Mb_Comment: Boolean := False; - - -- If set, relax rules about std library: working library can be std. - Bootstrap : Boolean := False; - - -- Options -dX - -- -dp: disp tree after parsing - Dump_Parse: Boolean := False; - - -- -ds: disp tree after semantic - Dump_Sem: Boolean := False; - - -- -dc: disp tree after canon - Dump_Canon : Boolean := False; - - -- -da: disp tree after annotation - Dump_Annotate: Boolean := False; - - -- --dall: makes -dX options to apply to all files. - Dump_All: Boolean := False; - - -- -dstats: disp statistics. - Dump_Stats : Boolean := False; - - -- -lX options: list tree as a vhdl file. - - -- --lall option: makes -lX options to apply to all files - List_All: Boolean := False; - - -- -lv: list verbose - List_Verbose: Boolean := False; - - -- -ls: list tree after semantic. - List_Sem: Boolean := False; - - -- -lc: list tree after canon. - List_Canon: Boolean := False; - - -- -la: list tree after back-end annotation. - List_Annotate: Boolean := False; - - -- -v: disp phase of compilation. - Verbose : Boolean := False; - - -- If set to true, it means that analyze is done for elaboration. - -- The purpose is to avoid spurious warning "will be checked - -- at elaboration" - Flag_Elaborate : Boolean := False; - - -- If set, a default aspect entity aspect might be an outdated unit. - -- Used by ghdldrv. - Flag_Elaborate_With_Outdated : Boolean := False; - - -- Do not display parse and sem warnings. Used during elaboration. - Flag_Only_Elab_Warnings : Boolean := False; - - -- If set, explicit subprogram declarations take precedence over - -- implicit declarations, even through use clauses. - Flag_Explicit : Boolean := False; - - -- If set, use 'L.C' rule from VHDL02 to do default component binding. - Flag_Syn_Binding : Boolean := False; - - -- If set, performs VITAL checks. - Flag_Vital_Checks : Boolean := True; - - -- --time-resolution=X - -- Where X corresponds to: - -- fs => 'f' - -- ps => 'p' - -- ns => 'n' - -- us => 'u' - -- ms => 'm' - -- sec => 's' - -- min => 'M' - -- hr => 'h' - Time_Resolution: Character := 'f'; - - -- Integer and time types can be either 32 bits or 64 bits values. - -- The default is 32 bits for Integer and 64 bits for Time. - -- Be very careful: if you don't use the default sizes, you may have to - -- change other parts of your systems (such as GRT). - Flag_Integer_64 : Boolean := False; - Flag_Time_64 : Boolean := True; - - -- If set, generate cross-references during sem. - Flag_Xref : Boolean := False; - - -- If set, all the design units are analyzed in whole to do the simulation. - Flag_Whole_Analyze : Boolean := False; - - -- If true, relax some rules: - -- * the scope of an object declaration names start after the declaration, - -- so that it is possible to use the old name in the default expression: - -- constant x : xtype := x; - Flag_Relaxed_Rules : Boolean := False; - - -- --warn-undriven - --Warn_Undriven : Boolean := False; - - -- --warn-default-binding - -- Should emit a warning when there is no default binding for a component - -- instantiation. - Warn_Default_Binding : Boolean := False; - - -- --warn-binding - -- Emit a warning at elaboration for unbound component. - Warn_Binding : Boolean := True; - - -- --warn-reserved - -- Emit a warning when a vhdl93 reserved word is used as a - -- vhdl87 identifier. - Warn_Reserved_Word : Boolean := False; - - -- --warn-library - -- Emit a warning when a design unit redefines another design unit. - Warn_Library : Boolean := False; - - -- --warn-vital-generic - -- Emit a warning when a generic of a vital entity is not a vital name. - Warn_Vital_Generic : Boolean := True; - - -- --warn-delayed-checks - -- Emit warnings about delayed checks (checks performed at elaboration - -- time). - Warn_Delayed_Checks : Boolean := False; - - -- --warn-body - -- Emit a warning when a package body is not required but is analyzed. - Warn_Body : Boolean := True; - - -- --warn-specs - -- Emit a warning when an all/others specification does not apply, because - -- there is no such named entities. - Warn_Specs : Boolean := True; - - -- --warn-unused - -- Emit a warning when a declaration is never used. - -- FIXME: currently only subprograms are handled. - Warn_Unused : Boolean := True; - - -- --warn-error - -- Turns warnings into errors. - Warn_Error : Boolean := False; -end Flags; diff --git a/ieee-std_logic_1164.adb b/ieee-std_logic_1164.adb deleted file mode 100644 index ee58fe7a5..000000000 --- a/ieee-std_logic_1164.adb +++ /dev/null @@ -1,170 +0,0 @@ --- Nodes recognizer for ieee.std_logic_1164. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Types; use Types; -with Std_Names; use Std_Names; -with Errorout; use Errorout; -with Std_Package; - -package body Ieee.Std_Logic_1164 is - function Skip_Implicit (Decl : Iir) return Iir - is - Res : Iir; - begin - Res := Decl; - loop - exit when Res = Null_Iir; - exit when Get_Kind (Res) /= Iir_Kind_Implicit_Function_Declaration; - Res := Get_Chain (Res); - end loop; - return Res; - end Skip_Implicit; - - procedure Extract_Declarations (Pkg : Iir_Package_Declaration) - is - Error : exception; - - Decl : Iir; - Def : Iir; - begin - Std_Logic_1164_Pkg := Pkg; - - Decl := Get_Declaration_Chain (Pkg); - - -- Skip a potential copyright constant. - if Decl /= Null_Iir - and then Get_Kind (Decl) = Iir_Kind_Constant_Declaration - and then (Get_Base_Type (Get_Type (Decl)) - = Std_Package.String_Type_Definition) - then - Decl := Get_Chain (Decl); - end if; - - -- The first declaration should be type std_ulogic. - if Decl = Null_Iir - or else Get_Kind (Decl) /= Iir_Kind_Type_Declaration - or else Get_Identifier (Decl) /= Name_Std_Ulogic - then - raise Error; - end if; - - Def := Get_Type_Definition (Decl); - if Get_Kind (Def) /= Iir_Kind_Enumeration_Type_Definition then - raise Error; - end if; - Std_Ulogic_Type := Def; - - -- The second declaration should be std_ulogic_vector. - Decl := Get_Chain (Decl); - Decl := Skip_Implicit (Decl); - if Decl = Null_Iir - or else Get_Kind (Decl) /= Iir_Kind_Type_Declaration - or else Get_Identifier (Decl) /= Name_Std_Ulogic_Vector - then - raise Error; - end if; - Def := Get_Type_Definition (Decl); - if Get_Kind (Def) /= Iir_Kind_Array_Type_Definition then - raise Error; - end if; - Std_Ulogic_Vector_Type := Def; - - -- The third declaration should be resolved. - Decl := Get_Chain (Decl); - Decl := Skip_Implicit (Decl); - if Decl = Null_Iir - or else Get_Kind (Decl) /= Iir_Kind_Function_Declaration - then - -- FIXME: check name ? - raise Error; - end if; - Resolved := Decl; - - -- The fourth declaration should be std_logic. - Decl := Get_Chain (Decl); - Decl := Skip_Implicit (Decl); - if Decl = Null_Iir - or else Get_Kind (Decl) /= Iir_Kind_Subtype_Declaration - or else Get_Identifier (Decl) /= Name_Std_Logic - then - raise Error; - end if; - Def := Get_Type (Decl); - if Get_Kind (Def) /= Iir_Kind_Enumeration_Subtype_Definition then - raise Error; - end if; - Std_Logic_Type := Def; - - -- The fifth declaration should be std_logic_vector. - Decl := Get_Chain (Decl); - Decl := Skip_Implicit (Decl); - if Decl = Null_Iir - or else (Get_Kind (Decl) /= Iir_Kind_Type_Declaration - and then Get_Kind (Decl) /= Iir_Kind_Subtype_Declaration) - or else Get_Identifier (Decl) /= Name_Std_Logic_Vector - then - raise Error; - end if; - Def := Get_Type (Decl); --- if Get_Kind (Def) /= Iir_Kind_Array_Type_Definition then --- raise Error; --- end if; - Std_Logic_Vector_Type := Def; - - -- Skip any declarations but functions. - loop - Decl := Get_Chain (Decl); - exit when Decl = Null_Iir; - - if Get_Kind (Decl) = Iir_Kind_Function_Declaration then - if Get_Identifier (Decl) = Name_Rising_Edge then - Rising_Edge := Decl; - elsif Get_Identifier (Decl) = Name_Falling_Edge then - Falling_Edge := Decl; - end if; - end if; - end loop; - - -- Since rising_edge and falling_edge do not read activity of its - -- parameter, clear the flag to allow more optimizations. - if Rising_Edge /= Null_Iir then - Set_Has_Active_Flag - (Get_Interface_Declaration_Chain (Rising_Edge), False); - else - raise Error; - end if; - if Falling_Edge /= Null_Iir then - Set_Has_Active_Flag - (Get_Interface_Declaration_Chain (Falling_Edge), False); - else - raise Error; - end if; - - exception - when Error => - Error_Msg_Sem ("package ieee.std_logic_1164 is ill-formed", Pkg); - - -- Clear all definitions. - Std_Logic_1164_Pkg := Null_Iir; - Std_Ulogic_Type := Null_Iir; - Std_Ulogic_Vector_Type := Null_Iir; - Std_Logic_Type := Null_Iir; - Std_Logic_Vector_Type := Null_Iir; - Rising_Edge := Null_Iir; - Falling_Edge := Null_Iir; - end Extract_Declarations; -end Ieee.Std_Logic_1164; diff --git a/ieee-std_logic_1164.ads b/ieee-std_logic_1164.ads deleted file mode 100644 index b1f14f272..000000000 --- a/ieee-std_logic_1164.ads +++ /dev/null @@ -1,35 +0,0 @@ --- Nodes recognizer for ieee.std_logic_1164. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Iirs; use Iirs; - -package Ieee.Std_Logic_1164 is - -- Nodes corresponding to declarations in the package. - Std_Logic_1164_Pkg : Iir_Package_Declaration := Null_Iir; - Std_Ulogic_Type : Iir_Enumeration_Type_Definition := Null_Iir; - Std_Ulogic_Vector_Type : Iir_Array_Type_Definition := Null_Iir; - Std_Logic_Type : Iir_Enumeration_Subtype_Definition := Null_Iir; - Std_Logic_Vector_Type : Iir_Array_Type_Definition := Null_Iir; - Resolved : Iir_Function_Declaration := Null_Iir; - Rising_Edge : Iir_Function_Declaration := Null_Iir; - Falling_Edge : Iir_Function_Declaration := Null_Iir; - - -- Extract declarations from PKG. - -- PKG is the package declaration for ieee.std_logic_1164 package. - -- Fills the node aboves. - procedure Extract_Declarations (Pkg : Iir_Package_Declaration); -end Ieee.Std_Logic_1164; diff --git a/ieee-vital_timing.adb b/ieee-vital_timing.adb deleted file mode 100644 index d6429e251..000000000 --- a/ieee-vital_timing.adb +++ /dev/null @@ -1,1377 +0,0 @@ --- Nodes recognizer for ieee.vital_timing. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Types; use Types; -with Std_Names; -with Errorout; use Errorout; -with Std_Package; use Std_Package; -with Tokens; use Tokens; -with Name_Table; -with Ieee.Std_Logic_1164; use Ieee.Std_Logic_1164; -with Sem_Scopes; -with Evaluation; -with Sem; -with Iirs_Utils; -with Flags; - -package body Ieee.Vital_Timing is - -- This package is based on IEEE 1076.4 1995. - - -- Control generics identifier. - InstancePath_Id : Name_Id; - TimingChecksOn_Id : Name_Id; - XOn_Id : Name_Id; - MsgOn_Id : Name_Id; - - -- Extract declarations from package IEEE.VITAL_Timing. - procedure Extract_Declarations (Pkg : Iir_Package_Declaration) - is - use Name_Table; - - Ill_Formed : exception; - - Decl : Iir; - Id : Name_Id; - - VitalDelayType_Id : Name_Id; - VitalDelayType01_Id : Name_Id; - VitalDelayType01Z_Id : Name_Id; - VitalDelayType01ZX_Id : Name_Id; - - VitalDelayArrayType_Id : Name_Id; - VitalDelayArrayType01_Id : Name_Id; - VitalDelayArrayType01Z_Id : Name_Id; - VitalDelayArrayType01ZX_Id : Name_Id; - begin - -- Get Vital delay type identifiers. - Name_Buffer (1 .. 18) := "vitaldelaytype01zx"; - Name_Length := 14; - VitalDelayType_Id := Get_Identifier_No_Create; - if VitalDelayType_Id = Null_Identifier then - raise Ill_Formed; - end if; - Name_Length := 16; - VitalDelayType01_Id := Get_Identifier_No_Create; - if VitalDelayType01_Id = Null_Identifier then - raise Ill_Formed; - end if; - Name_Length := 17; - VitalDelayType01Z_Id := Get_Identifier_No_Create; - if VitalDelayType01Z_Id = Null_Identifier then - raise Ill_Formed; - end if; - Name_Length := 18; - VitalDelayType01ZX_Id := Get_Identifier_No_Create; - if VitalDelayType01ZX_Id = Null_Identifier then - raise Ill_Formed; - end if; - - Name_Buffer (1 .. 23) := "vitaldelayarraytype01zx"; - Name_Length := 19; - VitalDelayArrayType_Id := Get_Identifier_No_Create; - if VitalDelayArrayType_Id = Null_Identifier then - raise Ill_Formed; - end if; - Name_Length := 21; - VitalDelayArrayType01_Id := Get_Identifier_No_Create; - if VitalDelayArrayType01_Id = Null_Identifier then - raise Ill_Formed; - end if; - Name_Length := 22; - VitalDelayArrayType01Z_Id := Get_Identifier_No_Create; - if VitalDelayArrayType01Z_Id = Null_Identifier then - raise Ill_Formed; - end if; - Name_Length := 23; - VitalDelayArrayType01ZX_Id := Get_Identifier_No_Create; - if VitalDelayArrayType01ZX_Id = Null_Identifier then - raise Ill_Formed; - end if; - - -- Iterate on every declaration. - -- Do name-matching. - Decl := Get_Declaration_Chain (Pkg); - while Decl /= Null_Iir loop - case Get_Kind (Decl) is - when Iir_Kind_Attribute_Declaration => - Id := Get_Identifier (Decl); - if Id = Std_Names.Name_VITAL_Level0 then - Vital_Level0_Attribute := Decl; - elsif Id = Std_Names.Name_VITAL_Level1 then - Vital_Level1_Attribute := Decl; - end if; - when Iir_Kind_Subtype_Declaration => - Id := Get_Identifier (Decl); - if Id = VitalDelayType_Id then - VitalDelayType := Get_Type (Decl); - end if; - when Iir_Kind_Type_Declaration => - Id := Get_Identifier (Decl); - if Id = VitalDelayArrayType_Id then - VitalDelayArrayType := Get_Type_Definition (Decl); - elsif Id = VitalDelayArrayType01_Id then - VitalDelayArrayType01 := Get_Type_Definition (Decl); - elsif Id = VitalDelayArrayType01Z_Id then - VitalDelayArrayType01Z := Get_Type_Definition (Decl); - elsif Id = VitalDelayArrayType01ZX_Id then - VitalDelayArrayType01ZX := Get_Type_Definition (Decl); - end if; - when Iir_Kind_Anonymous_Type_Declaration => - Id := Get_Identifier (Decl); - if Id = VitalDelayType01_Id then - VitalDelayType01 := Get_Type_Definition (Decl); - elsif Id = VitalDelayType01Z_Id then - VitalDelayType01Z := Get_Type_Definition (Decl); - elsif Id = VitalDelayType01ZX_Id then - VitalDelayType01ZX := Get_Type_Definition (Decl); - end if; - when others => - null; - end case; - Decl := Get_Chain (Decl); - end loop; - - -- If a declaration was not found, then the package is not the expected - -- one. - if Vital_Level0_Attribute = Null_Iir - or Vital_Level1_Attribute = Null_Iir - or VitalDelayType = Null_Iir - or VitalDelayType01 = Null_Iir - or VitalDelayType01Z = Null_Iir - or VitalDelayType01ZX = Null_Iir - or VitalDelayArrayType = Null_Iir - or VitalDelayArrayType01 = Null_Iir - or VitalDelayArrayType01Z = Null_Iir - or VitalDelayArrayType01ZX = Null_Iir - then - raise Ill_Formed; - end if; - - -- Create identifier for control generics. - InstancePath_Id := Get_Identifier ("instancepath"); - TimingChecksOn_Id := Get_Identifier ("timingcheckson"); - XOn_Id := Get_Identifier ("xon"); - MsgOn_Id := Get_Identifier ("msgon"); - - exception - when Ill_Formed => - Error_Msg_Sem ("package ieee.vital_timing is ill-formed", Pkg); - - Vital_Level0_Attribute := Null_Iir; - Vital_Level1_Attribute := Null_Iir; - - VitalDelayType := Null_Iir; - VitalDelayType01 := Null_Iir; - VitalDelayType01Z := Null_Iir; - VitalDelayType01ZX := Null_Iir; - - VitalDelayArrayType := Null_Iir; - VitalDelayArrayType01 := Null_Iir; - VitalDelayArrayType01Z := Null_Iir; - VitalDelayArrayType01ZX := Null_Iir; - end Extract_Declarations; - - procedure Error_Vital (Msg : String; Loc : Iir) renames Error_Msg_Sem; - procedure Error_Vital (Msg : String; Loc : Location_Type) - renames Error_Msg_Sem; - procedure Warning_Vital (Msg : String; Loc : Iir) renames Warning_Msg_Sem; - - -- Check DECL is the VITAL level 0 attribute specification. - procedure Check_Level0_Attribute_Specification (Decl : Iir) - is - Expr : Iir; - begin - if Get_Kind (Decl) /= Iir_Kind_Attribute_Specification - or else (Get_Named_Entity (Get_Attribute_Designator (Decl)) - /= Vital_Level0_Attribute) - then - Error_Vital - ("first declaration must be the VITAL attribute specification", - Decl); - return; - end if; - - -- IEEE 1076.4 4.1 - -- The expression in the VITAL_Level0 attribute specification shall be - -- the Boolean literal TRUE. - Expr := Get_Expression (Decl); - if Get_Kind (Expr) not in Iir_Kinds_Denoting_Name - or else Get_Named_Entity (Expr) /= Boolean_True - then - Error_Vital - ("the expression in the VITAL_Level0 attribute specification shall " - & "be the Boolean literal TRUE", Decl); - end if; - - -- IEEE 1076.4 4.1 - -- The entity specification of the decorating attribute specification - -- shall be such that the enclosing entity or architecture inherits the - -- VITAL_Level0 attribute. - case Get_Entity_Class (Decl) is - when Tok_Entity - | Tok_Architecture => - null; - when others => - Error_Vital ("VITAL attribute specification does not decorate the " - & "enclosing entity or architecture", Decl); - end case; - end Check_Level0_Attribute_Specification; - - procedure Check_Entity_Port_Declaration - (Decl : Iir_Interface_Signal_Declaration) - is - use Name_Table; - - Atype : Iir; - Base_Type : Iir; - Type_Decl : Iir; - begin - -- IEEE 1076.4 4.3.1 - -- The identifiers in an entity port declaration shall not contain - -- underscore characters. - Image (Get_Identifier (Decl)); - if Name_Buffer (1) = '/' then - Error_Vital ("VITAL entity port shall not be an extended identifier", - Decl); - end if; - for I in 1 .. Name_Length loop - if Name_Buffer (I) = '_' then - Error_Vital - ("VITAL entity port shall not contain underscore", Decl); - exit; - end if; - end loop; - - -- IEEE 1076.4 4.3.1 - -- A port that is declared in an entity port declaration shall not be - -- of mode LINKAGE. - if Get_Mode (Decl) = Iir_Linkage_Mode then - Error_Vital ("VITAL entity port shall not be of mode LINKAGE", Decl); - end if; - - -- IEEE 1076.4 4.3.1 - -- The type mark in an entity port declaration shall denote a type or - -- a subtype that is declared in package Std_Logic_1164. The type - -- mark in the declaration of a scalar port shall denote the subtype - -- Std_Ulogic or a subtype of Std_Ulogic. The type mark in the - -- declaration of an array port shall denote the type Std_Logic_Vector. - Atype := Get_Type (Decl); - Base_Type := Get_Base_Type (Atype); - Type_Decl := Get_Type_Declarator (Atype); - if Base_Type = Std_Logic_Vector_Type then - if Get_Resolution_Indication (Atype) /= Null_Iir then - Error_Vital - ("VITAL array port type cannot override resolution function", - Decl); - end if; - -- FIXME: is an unconstrained array port allowed ? - -- FIXME: what about staticness of the index_constraint ? - elsif Base_Type = Std_Ulogic_Type then - if Type_Decl = Null_Iir - or else Get_Parent (Type_Decl) /= Std_Logic_1164_Pkg - then - Error_Vital - ("VITAL entity port type mark shall be one of Std_Logic_1164", - Decl); - end if; - else - Error_Vital ("VITAL port type must be Std_Logic_Vector or Std_Ulogic", - Decl); - end if; - - if Get_Signal_Kind (Decl) /= Iir_No_Signal_Kind then - Error_Vital ("VITAL entity port cannot be guarded", Decl); - end if; - end Check_Entity_Port_Declaration; - - -- Current position in the generic name, stored into - -- name_table.name_buffer. - Gen_Name_Pos : Natural; - - -- Length of the generic name. - Gen_Name_Length : Natural; - - -- The generic being analyzed. - Gen_Decl : Iir; - Gen_Chain : Iir; - - procedure Error_Vital_Name (Str : String) - is - Loc : Location_Type; - begin - Loc := Get_Location (Gen_Decl); - Error_Vital (Str, Loc + Location_Type (Gen_Name_Pos - 1)); - end Error_Vital_Name; - - -- Check the next sub-string in the generic name is a port. - -- Returns the port. - function Check_Port return Iir - is - use Sem_Scopes; - use Name_Table; - - C : Character; - Res : Iir; - Id : Name_Id; - Inter : Name_Interpretation_Type; - begin - Name_Length := 0; - while Gen_Name_Pos <= Gen_Name_Length loop - C := Name_Buffer (Gen_Name_Pos); - Gen_Name_Pos := Gen_Name_Pos + 1; - exit when C = '_'; - Name_Length := Name_Length + 1; - Name_Buffer (Name_Length) := C; - end loop; - - if Name_Length = 0 then - Error_Vital_Name ("port expected in VITAL generic name"); - return Null_Iir; - end if; - - Id := Get_Identifier_No_Create; - Res := Null_Iir; - if Id /= Null_Identifier then - Inter := Get_Interpretation (Id); - if Valid_Interpretation (Inter) then - Res := Get_Declaration (Inter); - end if; - end if; - if Res = Null_Iir then - Warning_Vital ("'" & Name_Buffer (1 .. Name_Length) - & "' is not a port name (in VITAL generic name)", - Gen_Decl); - end if; - return Res; - end Check_Port; - - -- Checks the port is an input port. - function Check_Input_Port return Iir - is - use Name_Table; - - Res : Iir; - begin - Res := Check_Port; - if Res /= Null_Iir then - -- IEEE 1076.4 4.3.2.1.3 - -- an input port is a VHDL port of mode IN or INOUT. - case Get_Mode (Res) is - when Iir_In_Mode - | Iir_Inout_Mode => - null; - when others => - Error_Vital ("'" & Name_Buffer (1 .. Name_Length) - & "' must be an input port", Gen_Decl); - end case; - end if; - return Res; - end Check_Input_Port; - - -- Checks the port is an output port. - function Check_Output_Port return Iir - is - use Name_Table; - - Res : Iir; - begin - Res := Check_Port; - if Res /= Null_Iir then - -- IEEE 1076.4 4.3.2.1.3 - -- An output port is a VHDL port of mode OUT, INOUT or BUFFER. - case Get_Mode (Res) is - when Iir_Out_Mode - | Iir_Inout_Mode - | Iir_Buffer_Mode => - null; - when others => - Error_Vital ("'" & Name_Buffer (1 .. Name_Length) - & "' must be an output port", Gen_Decl); - end case; - end if; - return Res; - end Check_Output_Port; - - -- Extract a suffix from the generic name. - type Suffixes_Kind is - ( - Suffix_Name, -- [a-z]* - Suffix_Num_Name, -- [0-9]* - Suffix_Edge, -- posedge, negedge, 01, 10, 0z, z1, 1z, z0 - Suffix_Noedge, -- noedge - Suffix_Eon -- End of name - ); - - function Get_Next_Suffix_Kind return Suffixes_Kind - is - use Name_Table; - - Len : Natural; - P : constant Natural := Gen_Name_Pos; - C : Character; - begin - Len := 0; - while Gen_Name_Pos <= Gen_Name_Length loop - C := Name_Buffer (Gen_Name_Pos); - Gen_Name_Pos := Gen_Name_Pos + 1; - exit when C = '_'; - Len := Len + 1; - end loop; - if Len = 0 then - return Suffix_Eon; - end if; - - case Name_Buffer (P) is - when '0' => - if Len = 2 and then (Name_Buffer (P + 1) = '1' - or Name_Buffer (P + 1) = 'z') - then - return Suffix_Edge; - else - return Suffix_Num_Name; - end if; - when '1' => - if Len = 2 and then (Name_Buffer (P + 1) = '0' - or Name_Buffer (P + 1) = 'z') - then - return Suffix_Edge; - else - return Suffix_Num_Name; - end if; - when '2' .. '9' => - return Suffix_Num_Name; - when 'z' => - if Len = 2 and then (Name_Buffer (P + 1) = '0' - or Name_Buffer (P + 1) = '1') - then - return Suffix_Edge; - else - return Suffix_Name; - end if; - when 'p' => - if Len = 7 and then Name_Buffer (P .. P + 6) = "posedge" then - return Suffix_Edge; - else - return Suffix_Name; - end if; - when 'n' => - if Len = 7 and then Name_Buffer (P .. P + 6) = "negedge" then - return Suffix_Edge; - elsif Len = 6 and then Name_Buffer (P .. P + 5) = "noedge" then - return Suffix_Edge; - else - return Suffix_Name; - end if; - when 'a' .. 'm' - | 'o' - | 'q' .. 'y' => - return Suffix_Name; - when others => - raise Internal_Error; - end case; - end Get_Next_Suffix_Kind; - - -- ::= - -- - -- | - -- | _ - procedure Check_Simple_Condition_And_Or_Edge - is - First : Boolean := True; - begin - loop - case Get_Next_Suffix_Kind is - when Suffix_Eon => - -- Simple condition is optional. - return; - when Suffix_Edge => - if Get_Next_Suffix_Kind /= Suffix_Eon then - Error_Vital_Name ("garbage after edge"); - end if; - return; - when Suffix_Num_Name => - if First then - Error_Vital_Name ("condition is a simple name"); - end if; - when Suffix_Noedge => - Error_Vital_Name ("'noedge' not allowed in simple condition"); - when Suffix_Name => - null; - end case; - First := False; - end loop; - end Check_Simple_Condition_And_Or_Edge; - - -- ::= - -- [_] - -- - -- ::= - -- [_] - -- | [_]noedge - procedure Check_Full_Condition_And_Or_Edge - is - begin - case Get_Next_Suffix_Kind is - when Suffix_Eon => - -- FullCondition is always optional. - return; - when Suffix_Edge - | Suffix_Noedge => - Check_Simple_Condition_And_Or_Edge; - return; - when Suffix_Num_Name => - Error_Vital_Name ("condition is a simple name"); - when Suffix_Name => - null; - end case; - - loop - case Get_Next_Suffix_Kind is - when Suffix_Eon => - Error_Vital_Name ("missing edge or noedge"); - return; - when Suffix_Edge - | Suffix_Noedge => - Check_Simple_Condition_And_Or_Edge; - return; - when Suffix_Num_Name - | Suffix_Name => - null; - end case; - end loop; - end Check_Full_Condition_And_Or_Edge; - - procedure Check_End is - begin - if Get_Next_Suffix_Kind /= Suffix_Eon then - Error_Vital_Name ("garbage at end of name"); - end if; - end Check_End; - - -- Return the length of a port P. - -- If P is a scalar port, return PORT_LENGTH_SCALAR - -- If P is a vector, return the length of the vector (>= 0) - -- Otherwise, return PORT_LENGTH_ERROR. - Port_Length_Unknown : constant Iir_Int64 := -1; - Port_Length_Scalar : constant Iir_Int64 := -2; - Port_Length_Error : constant Iir_Int64 := -3; - function Get_Port_Length (P : Iir) return Iir_Int64 - is - Ptype : Iir; - Itype : Iir; - begin - Ptype := Get_Type (P); - if Get_Base_Type (Ptype) = Std_Ulogic_Type then - return Port_Length_Scalar; - elsif Get_Kind (Ptype) = Iir_Kind_Array_Subtype_Definition - and then Get_Base_Type (Ptype) = Std_Logic_Vector_Type - then - Itype := Get_First_Element (Get_Index_Subtype_List (Ptype)); - if Get_Type_Staticness (Itype) /= Locally then - return Port_Length_Unknown; - end if; - return Evaluation.Eval_Discrete_Type_Length (Itype); - else - return Port_Length_Error; - end if; - end Get_Port_Length; - - -- IEEE 1076.4 9.1 VITAL delay types and subtypes. - -- The transition dependent delay types are - -- VitalDelayType01, VitalDelayType01Z, VitalDelayType01ZX, - -- VitalDelayArrayType01, VitalDelayArrayType01Z, VitalDelayArrayType01ZX. - -- The first three are scalar forms, the last three are vector forms. - -- - -- The simple delay types and subtypes include - -- Time, VitalDelayType, and VitalDelayArrayType. - -- The first two are scalar forms, and the latter is the vector form. - type Timing_Generic_Type_Kind is - ( - Timing_Type_Simple_Scalar, - Timing_Type_Simple_Vector, - Timing_Type_Trans_Scalar, - Timing_Type_Trans_Vector, - Timing_Type_Bad - ); - - function Get_Timing_Generic_Type_Kind return Timing_Generic_Type_Kind - is - Gtype : Iir; - Btype : Iir; - begin - Gtype := Get_Type (Gen_Decl); - Btype := Get_Base_Type (Gtype); - case Get_Kind (Gtype) is - when Iir_Kind_Array_Subtype_Definition => - if Btype = VitalDelayArrayType then - return Timing_Type_Simple_Vector; - end if; - if Btype = VitalDelayType01 - or Btype = VitalDelayType01Z - or Btype = VitalDelayType01ZX - then - return Timing_Type_Trans_Scalar; - end if; - if Btype = VitalDelayArrayType01 - or Btype = VitalDelayArrayType01Z - or Btype = VitalDelayArrayType01ZX - then - return Timing_Type_Trans_Vector; - end if; - when Iir_Kind_Physical_Subtype_Definition => - if Gtype = Time_Subtype_Definition - or else Gtype = VitalDelayType - then - return Timing_Type_Simple_Scalar; - end if; - when others => - null; - end case; - Error_Vital ("type of timing generic is not a VITAL delay type", - Gen_Decl); - return Timing_Type_Bad; - end Get_Timing_Generic_Type_Kind; - - function Get_Timing_Generic_Type_Length return Iir_Int64 - is - Itype : Iir; - begin - Itype := Get_First_Element - (Get_Index_Subtype_List (Get_Type (Gen_Decl))); - if Get_Type_Staticness (Itype) /= Locally then - return Port_Length_Unknown; - else - return Evaluation.Eval_Discrete_Type_Length (Itype); - end if; - end Get_Timing_Generic_Type_Length; - - -- IEEE 1076.4 4.3.2.1.2 Timing generic subtypes - -- * If the timing generic is associated with a single port and that port - -- is a scalar, then the type of the timing generic shall be a scalar - -- form of delay type. - -- * If such a timing generic is associated with a single port and that - -- port is a vector, then the type of the timing generic shall be a - -- vector form of delay type, and the constraint on the generic shall - -- match that on the associated port. - procedure Check_Vital_Delay_Type (P : Iir; - Is_Simple : Boolean := False; - Is_Scalar : Boolean := False) - is - Kind : Timing_Generic_Type_Kind; - Len : Iir_Int64; - Len1 : Iir_Int64; - begin - Kind := Get_Timing_Generic_Type_Kind; - if P = Null_Iir or Kind = Timing_Type_Bad then - return; - end if; - Len := Get_Port_Length (P); - if Len = Port_Length_Scalar then - case Kind is - when Timing_Type_Simple_Scalar => - null; - when Timing_Type_Trans_Scalar => - if Is_Simple then - Error_Vital - ("VITAL simple scalar timing type expected", Gen_Decl); - return; - end if; - when others => - Error_Vital ("VITAL scalar timing type expected", Gen_Decl); - return; - end case; - elsif Len >= Port_Length_Unknown then - if Is_Scalar then - Error_Vital ("VITAL scalar timing type expected", Gen_Decl); - return; - end if; - - case Kind is - when Timing_Type_Simple_Vector => - null; - when Timing_Type_Trans_Vector => - if Is_Simple then - Error_Vital - ("VITAL simple vector timing type expected", Gen_Decl); - return; - end if; - when others => - Error_Vital ("VITAL vector timing type expected", Gen_Decl); - return; - end case; - Len1 := Get_Timing_Generic_Type_Length; - if Len1 /= Len then - Error_Vital ("length of port and VITAL vector timing subtype " - & "does not match", Gen_Decl); - end if; - end if; - end Check_Vital_Delay_Type; - - -- IEEE 1076.4 4.3.2.1.2 Timing generic subtypes - -- * If the timing generic is associated with two scalar ports, then the - -- type of the timing generic shall be a scalar form of delay type. - -- * If the timing generic is associated with two ports, one or more of - -- which is a vector, then the type of the timing generic shall be a - -- vector form of delay type, and the length of the index range of the - -- generic shall be equal to the product of the number of scalar - -- subelements in the first port and the number of scalar subelements - -- in the second port. - procedure Check_Vital_Delay_Type - (P1, P2 : Iir; - Is_Simple : Boolean := False; - Is_Scalar : Boolean := False) - is - Kind : Timing_Generic_Type_Kind; - Len1 : Iir_Int64; - Len2 : Iir_Int64; - Lenp : Iir_Int64; - begin - Kind := Get_Timing_Generic_Type_Kind; - if P1 = Null_Iir or P2 = Null_Iir or Kind = Timing_Type_Bad then - return; - end if; - Len1 := Get_Port_Length (P1); - Len2 := Get_Port_Length (P2); - if Len1 = Port_Length_Scalar and Len2 = Port_Length_Scalar then - case Kind is - when Timing_Type_Simple_Scalar => - null; - when Timing_Type_Trans_Scalar => - if Is_Simple then - Error_Vital - ("VITAL simple scalar timing type expected", Gen_Decl); - return; - end if; - when others => - Error_Vital ("VITAL scalar timing type expected", Gen_Decl); - return; - end case; - elsif Len1 >= Port_Length_Unknown or Len2 >= Port_Length_Unknown then - if Is_Scalar then - Error_Vital ("VITAL scalar timing type expected", Gen_Decl); - return; - end if; - case Kind is - when Timing_Type_Simple_Vector => - null; - when Timing_Type_Trans_Vector => - if Is_Simple then - Error_Vital - ("VITAL simple vector timing type expected", Gen_Decl); - return; - end if; - when others => - Error_Vital ("VITAL vector timing type expected", Gen_Decl); - return; - end case; - if Len1 = Port_Length_Scalar then - Len1 := 1; - elsif Len1 = Port_Length_Error then - return; - end if; - if Len2 = Port_Length_Scalar then - Len2 := 1; - elsif Len2 = Port_Length_Error then - return; - end if; - Lenp := Get_Timing_Generic_Type_Length; - if Lenp /= Len1 * Len2 then - Error_Vital ("length of port and VITAL vector timing subtype " - & "does not match", Gen_Decl); - end if; - end if; - end Check_Vital_Delay_Type; - - function Check_Timing_Generic_Prefix - (Decl : Iir_Interface_Constant_Declaration; Length : Natural) - return Boolean - is - use Name_Table; - begin - -- IEEE 1076.4 4.3.1 - -- It is an error for a model to use a timing generic prefix to begin - -- the simple name of an entity generic that is not a timing generic. - if Name_Length < Length or Name_Buffer (Length) /= '_' then - Error_Vital ("invalid use of a VITAL timing generic prefix", Decl); - return False; - end if; - Gen_Name_Pos := Length + 1; - Gen_Name_Length := Name_Length; - Gen_Decl := Decl; - return True; - end Check_Timing_Generic_Prefix; - - -- IEEE 1076.4 4.3.2.1.3.1 Propagation Delay - -- ::= - -- TPD__[_] - procedure Check_Propagation_Delay_Name - (Decl : Iir_Interface_Constant_Declaration) - is - Iport : Iir; - Oport : Iir; - begin - if not Check_Timing_Generic_Prefix (Decl, 4) then - return; - end if; - Iport := Check_Input_Port; - Oport := Check_Output_Port; - Check_Simple_Condition_And_Or_Edge; - Check_Vital_Delay_Type (Iport, Oport); - end Check_Propagation_Delay_Name; - - procedure Check_Test_Reference - is - Tport : Iir; - Rport : Iir; - begin - Tport := Check_Input_Port; - Rport := Check_Input_Port; - Check_Full_Condition_And_Or_Edge; - Check_Vital_Delay_Type (Tport, Rport, Is_Simple => True); - end Check_Test_Reference; - - -- tsetup - procedure Check_Input_Setup_Time_Name - (Decl : Iir_Interface_Constant_Declaration) - is - begin - if not Check_Timing_Generic_Prefix (Decl, 7) then - return; - end if; - Check_Test_Reference; - end Check_Input_Setup_Time_Name; - - -- thold - procedure Check_Input_Hold_Time_Name - (Decl : Iir_Interface_Constant_Declaration) - is - begin - if not Check_Timing_Generic_Prefix (Decl, 6) then - return; - end if; - Check_Test_Reference; - end Check_Input_Hold_Time_Name; - - -- trecovery - procedure Check_Input_Recovery_Time_Name - (Decl : Iir_Interface_Constant_Declaration) - is - begin - if not Check_Timing_Generic_Prefix (Decl, 10) then - return; - end if; - Check_Test_Reference; - end Check_Input_Recovery_Time_Name; - - -- tremoval - procedure Check_Input_Removal_Time_Name - (Decl : Iir_Interface_Constant_Declaration) - is - begin - if not Check_Timing_Generic_Prefix (Decl, 9) then - return; - end if; - Check_Test_Reference; - end Check_Input_Removal_Time_Name; - - -- tperiod - procedure Check_Input_Period_Name - (Decl : Iir_Interface_Constant_Declaration) - is - Iport : Iir; - begin - if not Check_Timing_Generic_Prefix (Decl, 8) then - return; - end if; - Iport := Check_Input_Port; - Check_Simple_Condition_And_Or_Edge; - Check_Vital_Delay_Type (Iport, Is_Simple => True); - end Check_Input_Period_Name; - - -- tpw - procedure Check_Pulse_Width_Name - (Decl : Iir_Interface_Constant_Declaration) - is - Iport : Iir; - begin - if not Check_Timing_Generic_Prefix (Decl, 4) then - return; - end if; - Iport := Check_Input_Port; - Check_Simple_Condition_And_Or_Edge; - Check_Vital_Delay_Type (Iport, Is_Simple => True); - end Check_Pulse_Width_Name; - - -- tskew - procedure Check_Input_Skew_Time_Name - (Decl : Iir_Interface_Constant_Declaration) - is - Fport : Iir; - Sport : Iir; - begin - if not Check_Timing_Generic_Prefix (Decl, 6) then - return; - end if; - Fport := Check_Port; - Sport := Check_Port; - Check_Full_Condition_And_Or_Edge; - Check_Vital_Delay_Type (Fport, Sport, Is_Simple => True); - end Check_Input_Skew_Time_Name; - - -- tncsetup - procedure Check_No_Change_Setup_Time_Name - (Decl : Iir_Interface_Constant_Declaration) - is - begin - if not Check_Timing_Generic_Prefix (Decl, 9) then - return; - end if; - Check_Test_Reference; - end Check_No_Change_Setup_Time_Name; - - -- tnchold - procedure Check_No_Change_Hold_Time_Name - (Decl : Iir_Interface_Constant_Declaration) - is - begin - if not Check_Timing_Generic_Prefix (Decl, 8) then - return; - end if; - Check_Test_Reference; - end Check_No_Change_Hold_Time_Name; - - -- tipd - procedure Check_Interconnect_Path_Delay_Name - (Decl : Iir_Interface_Constant_Declaration) - is - Iport : Iir; - begin - if not Check_Timing_Generic_Prefix (Decl, 5) then - return; - end if; - Iport := Check_Input_Port; - Check_End; - Check_Vital_Delay_Type (Iport); - end Check_Interconnect_Path_Delay_Name; - - -- tdevice - procedure Check_Device_Delay_Name - (Decl : Iir_Interface_Constant_Declaration) - is - Oport : Iir; - pragma Unreferenced (Oport); - Pos : Natural; - Kind : Timing_Generic_Type_Kind; - pragma Unreferenced (Kind); - begin - if not Check_Timing_Generic_Prefix (Decl, 8) then - return; - end if; - if Get_Next_Suffix_Kind /= Suffix_Name then - Error_Vital_Name ("instance_name expected in VITAL generic name"); - return; - end if; - Pos := Gen_Name_Pos; - if Get_Next_Suffix_Kind /= Suffix_Eon then - Gen_Name_Pos := Pos; - Oport := Check_Output_Port; - Check_End; - end if; - Kind := Get_Timing_Generic_Type_Kind; - end Check_Device_Delay_Name; - - -- tisd - procedure Check_Internal_Signal_Delay_Name - (Decl : Iir_Interface_Constant_Declaration) - is - Iport : Iir; - Cport : Iir; - begin - if not Check_Timing_Generic_Prefix (Decl, 5) then - return; - end if; - Iport := Check_Input_Port; - Cport := Check_Input_Port; - Check_End; - Check_Vital_Delay_Type (Iport, Cport, - Is_Simple => True, Is_Scalar => True); - end Check_Internal_Signal_Delay_Name; - - -- tbpd - procedure Check_Biased_Propagation_Delay_Name - (Decl : Iir_Interface_Constant_Declaration) - is - Iport : Iir; - Oport : Iir; - Cport : Iir; - pragma Unreferenced (Cport); - Clock_Start : Natural; - Clock_End : Natural; - begin - if not Check_Timing_Generic_Prefix (Decl, 5) then - return; - end if; - Iport := Check_Input_Port; - Oport := Check_Output_Port; - Clock_Start := Gen_Name_Pos - 1; -- At the '_'. - Cport := Check_Input_Port; - Clock_End := Gen_Name_Pos; - Check_Simple_Condition_And_Or_Edge; - Check_Vital_Delay_Type (Iport, Oport); - - -- IEEE 1076.4 4.3.2.1.3.14 Biased propagation delay - -- There shall exist, in the same entity generic clause, a corresponding - -- propagation delay generic denoting the same ports, condition name, - -- and edge. - declare - use Name_Table; - - -- '-1' is for the missing 'b' in 'tpd'. - Tpd_Name : String - (1 .. Gen_Name_Length - 1 - (Clock_End - Clock_Start)); - Tpd_Decl : Iir; - begin - Image (Get_Identifier (Decl)); - Tpd_Name (1) := 't'; - -- The part before '_'. - Tpd_Name (2 .. Clock_Start - 2) := Name_Buffer (3 .. Clock_Start - 1); - Tpd_Name (Clock_Start - 1 .. Tpd_Name'Last) := - Name_Buffer (Clock_End .. Name_Length); - - Tpd_Decl := Gen_Chain; - loop - exit when Tpd_Decl = Null_Iir; - Image (Get_Identifier (Tpd_Decl)); - exit when Name_Length = Tpd_Name'Length - and then Name_Buffer (1 .. Name_Length) = Tpd_Name; - Tpd_Decl := Get_Chain (Tpd_Decl); - end loop; - - if Tpd_Decl = Null_Iir then - Error_Vital - ("no matching 'tpd' generic for VITAL 'tbpd' timing generic", - Decl); - else - -- IEEE 1076.4 4.3.2.1.3.14 Biased propagation delay - -- Furthermore, the type of the biased propagation generic shall - -- be the same as the type of the corresponding delay generic. - if not Sem.Are_Trees_Equal (Get_Type (Decl), Get_Type (Tpd_Decl)) - then - Error_Vital - ("type of VITAL 'tbpd' generic mismatch type of " - & "'tpd' generic", Decl); - Error_Vital - ("(corresponding 'tpd' timing generic)", Tpd_Decl); - end if; - end if; - end; - end Check_Biased_Propagation_Delay_Name; - - -- ticd - procedure Check_Internal_Clock_Delay_Generic_Name - (Decl : Iir_Interface_Constant_Declaration) - is - Cport : Iir; - P_Start : Natural; - P_End : Natural; - begin - if not Check_Timing_Generic_Prefix (Decl, 5) then - return; - end if; - P_Start := Gen_Name_Pos; - Cport := Check_Input_Port; - P_End := Gen_Name_Pos; - Check_End; - Check_Vital_Delay_Type (Cport, Is_Simple => True, Is_Scalar => True); - - -- IEEE 1076.4 4.3.2.1.3.15 Internal clock delay - -- It is an error for a clocks signal name to appear as one of the - -- following elements in the name of a timing generic: - -- * As either the input port in the name of a biased propagation - -- delay generic. - -- * As the input signal name in an internal delay timing generic. - -- * As the test port in a timing check or recovery removal timing - -- generic. - -- FIXME: recovery OR removal ? - - if P_End - 1 /= Gen_Name_Length then - -- Do not check in case of error. - return; - end if; - declare - use Name_Table; - Port : String (1 .. Name_Length); - El : Iir; - Offset : Natural; - - procedure Check_Not_Clock - is - S : Natural; - begin - S := Offset; - loop - Offset := Offset + 1; - exit when Offset > Name_Length - or else Name_Buffer (Offset) = '_'; - end loop; - if Offset - S = Port'Length - and then Name_Buffer (S .. Offset - 1) = Port - then - Error_Vital ("clock port name of 'ticd' VITAL generic must not" - & " appear here", El); - end if; - end Check_Not_Clock; - begin - Port := Name_Buffer (P_Start .. Gen_Name_Length); - - El := Gen_Chain; - while El /= Null_Iir loop - Image (Get_Identifier (El)); - if Name_Length > 5 - and then Name_Buffer (1) = 't' - then - if Name_Buffer (2 .. 5) = "bpd_" then - Offset := 6; - Check_Not_Clock; -- input - Check_Not_Clock; -- output - elsif Name_Buffer (2 .. 5) = "isd_" then - Offset := 6; - Check_Not_Clock; -- input - elsif Name_Length > 10 - and then Name_Buffer (2 .. 10) = "recovery_" - then - Offset := 11; - Check_Not_Clock; -- test port - elsif Name_Length > 9 - and then Name_Buffer (2 .. 9) = "removal_" - then - Offset := 10; - Check_Not_Clock; - end if; - end if; - El := Get_Chain (El); - end loop; - end; - end Check_Internal_Clock_Delay_Generic_Name; - - procedure Check_Entity_Generic_Declaration - (Decl : Iir_Interface_Constant_Declaration) - is - use Name_Table; - Id : Name_Id; - begin - Id := Get_Identifier (Decl); - Image (Id); - - -- Extract prefix. - if Name_Buffer (1) = 't' and Name_Length >= 3 then - -- Timing generic names. - if Name_Buffer (2) = 'p' then - if Name_Buffer (3) = 'd' then - Check_Propagation_Delay_Name (Decl); -- tpd - return; - elsif Name_Buffer (3) = 'w' then - Check_Pulse_Width_Name (Decl); -- tpw - return; - elsif Name_Length >= 7 - and then Name_Buffer (3 .. 7) = "eriod" - then - Check_Input_Period_Name (Decl); -- tperiod - return; - end if; - elsif Name_Buffer (2) = 'i' - and then Name_Length >= 4 - and then Name_Buffer (4) = 'd' - then - if Name_Buffer (3) = 'p' then - Check_Interconnect_Path_Delay_Name (Decl); -- tipd - return; - elsif Name_Buffer (3) = 's' then - Check_Internal_Signal_Delay_Name (Decl); -- tisd - return; - elsif Name_Buffer (3) = 'c' then - Check_Internal_Clock_Delay_Generic_Name (Decl); -- ticd - return; - end if; - elsif Name_Length >= 6 and then Name_Buffer (2 .. 6) = "setup" then - Check_Input_Setup_Time_Name (Decl); -- tsetup - return; - elsif Name_Length >= 5 and then Name_Buffer (2 .. 5) = "hold" then - Check_Input_Hold_Time_Name (Decl); -- thold - return; - elsif Name_Length >= 9 and then Name_Buffer (2 .. 9) = "recovery" then - Check_Input_Recovery_Time_Name (Decl); -- trecovery - return; - elsif Name_Length >= 8 and then Name_Buffer (2 .. 8) = "removal" then - Check_Input_Removal_Time_Name (Decl); -- tremoval - return; - elsif Name_Length >= 5 and then Name_Buffer (2 .. 5) = "skew" then - Check_Input_Skew_Time_Name (Decl); -- tskew - return; - elsif Name_Length >= 8 and then Name_Buffer (2 .. 8) = "ncsetup" then - Check_No_Change_Setup_Time_Name (Decl); -- tncsetup - return; - elsif Name_Length >= 7 and then Name_Buffer (2 .. 7) = "nchold" then - Check_No_Change_Hold_Time_Name (Decl); -- tnchold - return; - elsif Name_Length >= 7 and then Name_Buffer (2 .. 7) = "device" then - Check_Device_Delay_Name (Decl); -- tdevice - return; - elsif Name_Length >= 4 and then Name_Buffer (2 .. 4) = "bpd" then - Check_Biased_Propagation_Delay_Name (Decl); -- tbpd - return; - end if; - end if; - - if Id = InstancePath_Id then - if Get_Type (Decl) /= String_Type_Definition then - Error_Vital - ("InstancePath VITAL generic must be of type String", Decl); - end if; - return; - elsif Id = TimingChecksOn_Id - or Id = XOn_Id - or Id = MsgOn_Id - then - if Get_Type (Decl) /= Boolean_Type_Definition then - Error_Vital - (Image (Id) & " VITAL generic must be of type Boolean", Decl); - end if; - return; - end if; - - if Flags.Warn_Vital_Generic then - Warning_Vital (Disp_Node (Decl) & " is not a VITAL generic", Decl); - end if; - end Check_Entity_Generic_Declaration; - - -- Checks rules for a VITAL level 0 entity. - procedure Check_Vital_Level0_Entity (Ent : Iir_Entity_Declaration) - is - use Sem_Scopes; - Decl : Iir; - begin - -- IEEE 1076.4 4.3.1 - -- The only form of declaration allowed in the entity declarative part - -- is the specification of the VITAL_Level0 attribute. - Decl := Get_Declaration_Chain (Ent); - if Decl = Null_Iir then - -- Cannot happen, since there is at least the attribute spec. - raise Internal_Error; - end if; - Check_Level0_Attribute_Specification (Decl); - Decl := Get_Chain (Decl); - if Decl /= Null_Iir then - Error_Vital ("VITAL entity declarative part must only contain the " - & "attribute specification", Decl); - end if; - - -- IEEE 1076.4 4.3.1 - -- No statements are allowed in the entity statement part. - Decl := Get_Concurrent_Statement_Chain (Ent); - if Decl /= Null_Iir then - Error_Vital ("VITAL entity must not have concurrent statement", Decl); - end if; - - -- Check ports. - Name_Table.Assert_No_Infos; - Open_Declarative_Region; - Decl := Get_Port_Chain (Ent); - while Decl /= Null_Iir loop - Check_Entity_Port_Declaration (Decl); - Add_Name (Decl); - Decl := Get_Chain (Decl); - end loop; - - -- Check generics. - Gen_Chain := Get_Generic_Chain (Ent); - Decl := Gen_Chain; - while Decl /= Null_Iir loop - Check_Entity_Generic_Declaration (Decl); - Decl := Get_Chain (Decl); - end loop; - Close_Declarative_Region; - end Check_Vital_Level0_Entity; - - -- Return TRUE if UNIT was decorated with attribute VITAL_Level0. - function Is_Vital_Level0 (Unit : Iir_Entity_Declaration) return Boolean - is - Value : Iir_Attribute_Value; - Spec : Iir_Attribute_Specification; - begin - Value := Get_Attribute_Value_Chain (Unit); - while Value /= Null_Iir loop - Spec := Get_Attribute_Specification (Value); - if Get_Named_Entity (Get_Attribute_Designator (Spec)) - = Vital_Level0_Attribute - then - return True; - end if; - Value := Get_Chain (Value); - end loop; - - return False; - end Is_Vital_Level0; - - procedure Check_Vital_Level0_Architecture (Arch : Iir_Architecture_Body) - is - Decl : Iir; - begin - -- IEEE 1076.4 4.1 - -- The entity associated with a Level 0 architecture shall be a VITAL - -- Level 0 entity. - if not Is_Vital_Level0 (Iirs_Utils.Get_Entity (Arch)) then - Error_Vital ("entity associated with a VITAL level 0 architecture " - & "shall be a VITAL level 0 entity", Arch); - end if; - - -- VITAL_Level_0_architecture_declarative_part ::= - -- VITAL_Level0_attribute_specification { block_declarative_item } - Decl := Get_Declaration_Chain (Arch); - Check_Level0_Attribute_Specification (Decl); - end Check_Vital_Level0_Architecture; - - -- Check a VITAL level 0 decorated design unit. - procedure Check_Vital_Level0 (Unit : Iir_Design_Unit) - is - Lib_Unit : Iir; - begin - Lib_Unit := Get_Library_Unit (Unit); - case Get_Kind (Lib_Unit) is - when Iir_Kind_Entity_Declaration => - Check_Vital_Level0_Entity (Lib_Unit); - when Iir_Kind_Architecture_Body => - Check_Vital_Level0_Architecture (Lib_Unit); - when others => - Error_Vital - ("only entity or architecture can be VITAL_Level0", Lib_Unit); - end case; - end Check_Vital_Level0; - - procedure Check_Vital_Level1 (Unit : Iir_Design_Unit) - is - Arch : Iir; - begin - Arch := Get_Library_Unit (Unit); - if Get_Kind (Arch) /= Iir_Kind_Architecture_Body then - Error_Vital ("only architecture can be VITAL_Level1", Arch); - return; - end if; - -- FIXME: todo - end Check_Vital_Level1; - -end Ieee.Vital_Timing; diff --git a/ieee-vital_timing.ads b/ieee-vital_timing.ads deleted file mode 100644 index 7abda2eba..000000000 --- a/ieee-vital_timing.ads +++ /dev/null @@ -1,41 +0,0 @@ --- Nodes recognizer for ieee.vital_timing. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Iirs; use Iirs; - -package Ieee.Vital_Timing is - -- Attribute declarations. - Vital_Level0_Attribute : Iir_Attribute_Declaration := Null_Iir; - Vital_Level1_Attribute : Iir_Attribute_Declaration := Null_Iir; - - -- Vital delay types. - VitalDelayType : Iir := Null_Iir; - VitalDelayType01 : Iir_Array_Type_Definition := Null_Iir; - VitalDelayType01Z : Iir_Array_Type_Definition := Null_Iir; - VitalDelayType01ZX : Iir_Array_Type_Definition := Null_Iir; - - VitalDelayArrayType : Iir_Array_Type_Definition := Null_Iir; - VitalDelayArrayType01 : Iir_Array_Type_Definition := Null_Iir; - VitalDelayArrayType01Z : Iir_Array_Type_Definition := Null_Iir; - VitalDelayArrayType01ZX : Iir_Array_Type_Definition := Null_Iir; - - -- Extract declarations from IEEE.VITAL_Timing package. - procedure Extract_Declarations (Pkg : Iir_Package_Declaration); - - procedure Check_Vital_Level0 (Unit : Iir_Design_Unit); - procedure Check_Vital_Level1 (Unit : Iir_Design_Unit); -end Ieee.Vital_Timing; diff --git a/ieee.ads b/ieee.ads deleted file mode 100644 index 48ab37630..000000000 --- a/ieee.ads +++ /dev/null @@ -1,5 +0,0 @@ --- Top of ieee hierarchy. --- Too small to be copyrighted. -package Ieee is - pragma Pure (Ieee); -end Ieee; diff --git a/iir_chain_handling.adb b/iir_chain_handling.adb deleted file mode 100644 index 1e70a366a..000000000 --- a/iir_chain_handling.adb +++ /dev/null @@ -1,68 +0,0 @@ --- Generic package to handle chains. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -package body Iir_Chain_Handling is - procedure Build_Init (Last : out Iir) is - begin - Last := Null_Iir; - end Build_Init; - - procedure Build_Init (Last : out Iir; Parent : Iir) - is - El : Iir; - begin - El := Get_Chain_Start (Parent); - if El /= Null_Iir then - loop - Last := El; - El := Get_Chain (El); - exit when El = Null_Iir; - end loop; - else - Last := Null_Iir; - end if; - end Build_Init; - - procedure Append (Last : in out Iir; Parent : Iir; El : Iir) is - begin - if Last = Null_Iir then - Set_Chain_Start (Parent, El); - else - Set_Chain (Last, El); - end if; - Last := El; - end Append; - - procedure Append_Subchain (Last : in out Iir; Parent : Iir; Els : Iir) - is - El : Iir; - begin - if Last = Null_Iir then - Set_Chain_Start (Parent, Els); - else - Set_Chain (Last, Els); - end if; - El := Els; - loop - Set_Parent (El, Parent); - Last := El; - El := Get_Chain (El); - exit when El = Null_Iir; - end loop; - end Append_Subchain; -end Iir_Chain_Handling; - diff --git a/iir_chain_handling.ads b/iir_chain_handling.ads deleted file mode 100644 index 3865e9b65..000000000 --- a/iir_chain_handling.ads +++ /dev/null @@ -1,47 +0,0 @@ --- Generic package to handle chains. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Iirs; use Iirs; - --- The generic package Chain_Handling can be used to build or modify --- chains. --- The formals are the subprograms to get and set the first element --- from the parent. -generic - with function Get_Chain_Start (Parent : Iir) return Iir; - with procedure Set_Chain_Start (Parent : Iir; First : Iir); -package Iir_Chain_Handling is - - -- Building a chain: - -- Initialize (set LAST to NULL_IIR). - procedure Build_Init (Last : out Iir); - -- Set LAST with the last element of the chain. - -- This is an initialization for an already built chain. - procedure Build_Init (Last : out Iir; Parent : Iir); - - -- Append element EL to the chain, whose parent is PARENT and last - -- element LAST. - procedure Append (Last : in out Iir; Parent : Iir; El : Iir); - - -- Append a subchain whose first element is ELS to a chain, whose - -- parent is PARENT and last element LAST. - -- The Parent field of each elements of Els is set to PARENT. - -- Note: the Append procedure declared just above is an optimization - -- of this subprogram if ELS has no next element. However, the - -- above subprogram does not set the Parent field of EL. - procedure Append_Subchain (Last : in out Iir; Parent : Iir; Els : Iir); -end Iir_Chain_Handling; diff --git a/iir_chains.adb b/iir_chains.adb deleted file mode 100644 index ef47b6485..000000000 --- a/iir_chains.adb +++ /dev/null @@ -1,64 +0,0 @@ --- Chain handling. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -package body Iir_Chains is - function Get_Chain_Length (First : Iir) return Natural - is - Res : Natural := 0; - El : Iir := First; - begin - while El /= Null_Iir loop - Res := Res + 1; - El := Get_Chain (El); - end loop; - return Res; - end Get_Chain_Length; - - procedure Sub_Chain_Init (First, Last : out Iir) is - begin - First := Null_Iir; - Last := Null_Iir; - end Sub_Chain_Init; - - procedure Sub_Chain_Append (First, Last : in out Iir; El : Iir) is - begin - if First = Null_Iir then - First := El; - else - Set_Chain (Last, El); - end if; - Last := El; - end Sub_Chain_Append; - - function Is_Chain_Length_One (Chain : Iir) return Boolean is - begin - return Chain /= Null_Iir and then Get_Chain (Chain) = Null_Iir; - end Is_Chain_Length_One; - - procedure Insert (Last : Iir; El : Iir) is - begin - Set_Chain (El, Get_Chain (Last)); - Set_Chain (Last, El); - end Insert; - - procedure Insert_Incr (Last : in out Iir; El : Iir) is - begin - Set_Chain (El, Get_Chain (Last)); - Set_Chain (Last, El); - Last := El; - end Insert_Incr; -end Iir_Chains; diff --git a/iir_chains.ads b/iir_chains.ads deleted file mode 100644 index dc2f3894c..000000000 --- a/iir_chains.ads +++ /dev/null @@ -1,113 +0,0 @@ --- Chain handling. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Iirs; use Iirs; -with Iir_Chain_Handling; -pragma Elaborate_All (Iir_Chain_Handling); - -package Iir_Chains is - -- Chains are simply linked list of iirs. - -- Elements of the chain are ordered. - -- Each element of a chain have a Chain field, which points to the next - -- element. - -- All elements of a chain have the same parent. This parent contains - -- a field which points to the first element of the chain. - -- Note: the parent is often the value of the Parent field, but sometimes - -- not. - - -- Chains can be covered very simply: - -- El : Iir; - -- begin - -- El := Get_xxx_Chain (Parent); - -- while El /= Null_Iir loop - -- * Handle element EL of the chain. - -- El := Get_Chain (El); - -- end loop; - - -- However, building a chain is a little bit more difficult if elements - -- have to be appended. Indeed, there is no direct access to the last - -- element of a chain. - -- An efficient way to build a chain is to keep the last element of it. - -- See Iir_Chain_Handling package. - - package Declaration_Chain_Handling is new Iir_Chain_Handling - (Get_Chain_Start => Get_Declaration_Chain, - Set_Chain_Start => Set_Declaration_Chain); - - package Interface_Declaration_Chain_Handling is new Iir_Chain_Handling - (Get_Chain_Start => Get_Interface_Declaration_Chain, - Set_Chain_Start => Set_Interface_Declaration_Chain); - - package Context_Items_Chain_Handling is new Iir_Chain_Handling - (Get_Chain_Start => Get_Context_Items, - Set_Chain_Start => Set_Context_Items); - - package Unit_Chain_Handling is new Iir_Chain_Handling - (Get_Chain_Start => Get_Unit_Chain, - Set_Chain_Start => Set_Unit_Chain); - - package Configuration_Item_Chain_Handling is new Iir_Chain_Handling - (Get_Chain_Start => Get_Configuration_Item_Chain, - Set_Chain_Start => Set_Configuration_Item_Chain); - - package Entity_Class_Entry_Chain_Handling is new Iir_Chain_Handling - (Get_Chain_Start => Get_Entity_Class_Entry_Chain, - Set_Chain_Start => Set_Entity_Class_Entry_Chain); - - package Conditional_Waveform_Chain_Handling is new Iir_Chain_Handling - (Get_Chain_Start => Get_Conditional_Waveform_Chain, - Set_Chain_Start => Set_Conditional_Waveform_Chain); - - package Selected_Waveform_Chain_Handling is new Iir_Chain_Handling - (Get_Chain_Start => Get_Selected_Waveform_Chain, - Set_Chain_Start => Set_Selected_Waveform_Chain); - - package Association_Choices_Chain_Handling is new Iir_Chain_Handling - (Get_Chain_Start => Get_Association_Choices_Chain, - Set_Chain_Start => Set_Association_Choices_Chain); - - package Case_Statement_Alternative_Chain_Handling is new Iir_Chain_Handling - (Get_Chain_Start => Get_Case_Statement_Alternative_Chain, - Set_Chain_Start => Set_Case_Statement_Alternative_Chain); - - -- Return the number of elements in a chain starting with FIRST. - -- Not very efficient since O(N). - function Get_Chain_Length (First : Iir) return Natural; - - -- These two subprograms can be used to build a sub-chain. - -- FIRST and LAST designates respectively the first and last element of - -- the sub-chain. - - -- Set FIRST and LAST to Null_Iir. - procedure Sub_Chain_Init (First, Last : out Iir); - pragma Inline (Sub_Chain_Init); - - -- Append element EL to the sub-chain. - procedure Sub_Chain_Append (First, Last : in out Iir; El : Iir); - pragma Inline (Sub_Chain_Append); - - -- Return TRUE iff CHAIN is of length one, ie CHAIN is not NULL_IIR - -- and chain (CHAIN) is NULL_IIR. - function Is_Chain_Length_One (Chain : Iir) return Boolean; - pragma Inline (Is_Chain_Length_One); - - -- Insert EL after LAST. - procedure Insert (Last : Iir; El : Iir); - - -- Insert EL after LAST and set LAST to EL. - procedure Insert_Incr (Last : in out Iir; El : Iir); -end Iir_Chains; diff --git a/iirs.adb b/iirs.adb deleted file mode 100644 index 876d1464f..000000000 --- a/iirs.adb +++ /dev/null @@ -1,4515 +0,0 @@ --- Tree node definitions. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Ada.Unchecked_Conversion; -with Ada.Text_IO; -with Nodes; use Nodes; -with Lists; use Lists; -with Nodes_Meta; use Nodes_Meta; - -package body Iirs is - function Is_Null (Node : Iir) return Boolean is - begin - return Node = Null_Iir; - end Is_Null; - - function Is_Null_List (Node : Iir_List) return Boolean is - begin - return Node = Null_Iir_List; - end Is_Null_List; - - --------------------------------------------------- - -- General subprograms that operate on every iir -- - --------------------------------------------------- - - function Get_Format (Kind : Iir_Kind) return Format_Type; - - function Create_Iir (Kind : Iir_Kind) return Iir - is - Res : Iir; - Format : Format_Type; - begin - Format := Get_Format (Kind); - Res := Create_Node (Format); - Set_Nkind (Res, Iir_Kind'Pos (Kind)); - return Res; - end Create_Iir; - - -- Statistics. - procedure Disp_Stats - is - use Ada.Text_IO; - type Num_Array is array (Iir_Kind) of Natural; - Num : Num_Array := (others => 0); - type Format_Array is array (Format_Type) of Natural; - Formats : Format_Array := (others => 0); - Kind : Iir_Kind; - I : Iir; - Last_I : Iir; - Format : Format_Type; - begin - I := Error_Node + 1; - Last_I := Get_Last_Node; - while I < Last_I loop - Kind := Get_Kind (I); - Num (Kind) := Num (Kind) + 1; - Format := Get_Format (Kind); - Formats (Format) := Formats (Format) + 1; - case Format is - when Format_Medium => - I := I + 2; - when Format_Short - | Format_Fp - | Format_Int => - I := I + 1; - end case; - end loop; - - Put_Line ("Stats per iir_kind:"); - for J in Iir_Kind loop - if Num (J) /= 0 then - Put_Line (' ' & Iir_Kind'Image (J) & ':' - & Natural'Image (Num (J))); - end if; - end loop; - Put_Line ("Stats per formats:"); - for J in Format_Type loop - Put_Line (' ' & Format_Type'Image (J) & ':' - & Natural'Image (Formats (J))); - end loop; - end Disp_Stats; - - function Iir_Predefined_Shortcut_P (Func : Iir_Predefined_Functions) - return Boolean is - begin - case Func is - when Iir_Predefined_Bit_And - | Iir_Predefined_Bit_Or - | Iir_Predefined_Bit_Nand - | Iir_Predefined_Bit_Nor - | Iir_Predefined_Boolean_And - | Iir_Predefined_Boolean_Or - | Iir_Predefined_Boolean_Nand - | Iir_Predefined_Boolean_Nor => - return True; - when others => - return False; - end case; - end Iir_Predefined_Shortcut_P; - - function Create_Iir_Error return Iir - is - Res : Iir; - begin - Res := Create_Node (Format_Short); - Set_Nkind (Res, Iir_Kind'Pos (Iir_Kind_Error)); - Set_Base_Type (Res, Res); - return Res; - end Create_Iir_Error; - - procedure Location_Copy (Target: Iir; Src: Iir) is - begin - Set_Location (Target, Get_Location (Src)); - end Location_Copy; - - -- Get kind - function Get_Kind (An_Iir: Iir) return Iir_Kind - is - -- Speed up: avoid to check that nkind is in the bounds of Iir_Kind. - pragma Suppress (Range_Check); - begin - return Iir_Kind'Val (Get_Nkind (An_Iir)); - end Get_Kind; - - function Time_Stamp_Id_To_Iir is new Ada.Unchecked_Conversion - (Source => Time_Stamp_Id, Target => Iir); - - function Iir_To_Time_Stamp_Id is new Ada.Unchecked_Conversion - (Source => Iir, Target => Time_Stamp_Id); - - function Iir_To_Iir_List is new Ada.Unchecked_Conversion - (Source => Iir, Target => Iir_List); - function Iir_List_To_Iir is new Ada.Unchecked_Conversion - (Source => Iir_List, Target => Iir); - - function Iir_To_Token_Type (N : Iir) return Token_Type is - begin - return Token_Type'Val (N); - end Iir_To_Token_Type; - - function Token_Type_To_Iir (T : Token_Type) return Iir is - begin - return Token_Type'Pos (T); - end Token_Type_To_Iir; - --- function Iir_To_Iir_Index32 (N : Iir) return Iir_Index32 is --- begin --- return Iir_Index32 (N); --- end Iir_To_Iir_Index32; - --- function Iir_Index32_To_Iir (V : Iir_Index32) return Iir is --- begin --- return Iir_Index32'Pos (V); --- end Iir_Index32_To_Iir; - - function Iir_To_Name_Id (N : Iir) return Name_Id is - begin - return Iir'Pos (N); - end Iir_To_Name_Id; - pragma Inline (Iir_To_Name_Id); - - function Name_Id_To_Iir (V : Name_Id) return Iir is - begin - return Name_Id'Pos (V); - end Name_Id_To_Iir; - - function Iir_To_Iir_Int32 is new Ada.Unchecked_Conversion - (Source => Iir, Target => Iir_Int32); - - function Iir_Int32_To_Iir is new Ada.Unchecked_Conversion - (Source => Iir_Int32, Target => Iir); - - function Iir_To_Source_Ptr (N : Iir) return Source_Ptr is - begin - return Source_Ptr (N); - end Iir_To_Source_Ptr; - - function Source_Ptr_To_Iir (P : Source_Ptr) return Iir is - begin - return Iir (P); - end Source_Ptr_To_Iir; - - function Iir_To_Location_Type (N : Iir) return Location_Type is - begin - return Location_Type (N); - end Iir_To_Location_Type; - - function Location_Type_To_Iir (L : Location_Type) return Iir is - begin - return Iir (L); - end Location_Type_To_Iir; - - function Iir_To_String_Id is new Ada.Unchecked_Conversion - (Source => Iir, Target => String_Id); - function String_Id_To_Iir is new Ada.Unchecked_Conversion - (Source => String_Id, Target => Iir); - - function Iir_To_Int32 is new Ada.Unchecked_Conversion - (Source => Iir, Target => Int32); - function Int32_To_Iir is new Ada.Unchecked_Conversion - (Source => Int32, Target => Iir); - - function Iir_To_PSL_Node is new Ada.Unchecked_Conversion - (Source => Iir, Target => PSL_Node); - - function PSL_Node_To_Iir is new Ada.Unchecked_Conversion - (Source => PSL_Node, Target => Iir); - - function Iir_To_PSL_NFA is new Ada.Unchecked_Conversion - (Source => Iir, Target => PSL_NFA); - - function PSL_NFA_To_Iir is new Ada.Unchecked_Conversion - (Source => PSL_NFA, Target => Iir); - - -- Subprograms - function Get_Format (Kind : Iir_Kind) return Format_Type is - begin - case Kind is - when Iir_Kind_Unused - | Iir_Kind_Error - | Iir_Kind_Library_Clause - | Iir_Kind_Use_Clause - | Iir_Kind_Null_Literal - | Iir_Kind_String_Literal - | Iir_Kind_Simple_Aggregate - | Iir_Kind_Overflow_Literal - | Iir_Kind_Waveform_Element - | Iir_Kind_Conditional_Waveform - | Iir_Kind_Association_Element_By_Expression - | Iir_Kind_Association_Element_By_Individual - | Iir_Kind_Association_Element_Open - | Iir_Kind_Association_Element_Package - | Iir_Kind_Choice_By_Others - | Iir_Kind_Choice_By_Expression - | Iir_Kind_Choice_By_Range - | Iir_Kind_Choice_By_None - | Iir_Kind_Choice_By_Name - | Iir_Kind_Entity_Aspect_Entity - | Iir_Kind_Entity_Aspect_Configuration - | Iir_Kind_Entity_Aspect_Open - | Iir_Kind_Block_Configuration - | Iir_Kind_Component_Configuration - | Iir_Kind_Entity_Class - | Iir_Kind_Attribute_Value - | Iir_Kind_Aggregate_Info - | Iir_Kind_Procedure_Call - | Iir_Kind_Record_Element_Constraint - | Iir_Kind_Array_Element_Resolution - | Iir_Kind_Record_Resolution - | Iir_Kind_Record_Element_Resolution - | Iir_Kind_Disconnection_Specification - | Iir_Kind_Configuration_Specification - | Iir_Kind_Access_Type_Definition - | Iir_Kind_Incomplete_Type_Definition - | Iir_Kind_File_Type_Definition - | Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Record_Type_Definition - | Iir_Kind_Access_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Integer_Type_Definition - | Iir_Kind_Floating_Type_Definition - | Iir_Kind_Physical_Type_Definition - | Iir_Kind_Range_Expression - | Iir_Kind_Protected_Type_Body - | Iir_Kind_Overload_List - | Iir_Kind_Type_Declaration - | Iir_Kind_Anonymous_Type_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Nature_Declaration - | Iir_Kind_Subnature_Declaration - | Iir_Kind_Package_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Attribute_Declaration - | Iir_Kind_Group_Template_Declaration - | Iir_Kind_Group_Declaration - | Iir_Kind_Element_Declaration - | Iir_Kind_Non_Object_Alias_Declaration - | Iir_Kind_Terminal_Declaration - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_Identity_Operator - | Iir_Kind_Negation_Operator - | Iir_Kind_Absolute_Operator - | Iir_Kind_Not_Operator - | Iir_Kind_Condition_Operator - | Iir_Kind_Reduction_And_Operator - | Iir_Kind_Reduction_Or_Operator - | Iir_Kind_Reduction_Nand_Operator - | Iir_Kind_Reduction_Nor_Operator - | Iir_Kind_Reduction_Xor_Operator - | Iir_Kind_Reduction_Xnor_Operator - | Iir_Kind_And_Operator - | Iir_Kind_Or_Operator - | Iir_Kind_Nand_Operator - | Iir_Kind_Nor_Operator - | Iir_Kind_Xor_Operator - | Iir_Kind_Xnor_Operator - | Iir_Kind_Equality_Operator - | Iir_Kind_Inequality_Operator - | Iir_Kind_Less_Than_Operator - | Iir_Kind_Less_Than_Or_Equal_Operator - | Iir_Kind_Greater_Than_Operator - | Iir_Kind_Greater_Than_Or_Equal_Operator - | Iir_Kind_Match_Equality_Operator - | Iir_Kind_Match_Inequality_Operator - | Iir_Kind_Match_Less_Than_Operator - | Iir_Kind_Match_Less_Than_Or_Equal_Operator - | Iir_Kind_Match_Greater_Than_Operator - | Iir_Kind_Match_Greater_Than_Or_Equal_Operator - | Iir_Kind_Sll_Operator - | Iir_Kind_Sla_Operator - | Iir_Kind_Srl_Operator - | Iir_Kind_Sra_Operator - | Iir_Kind_Rol_Operator - | Iir_Kind_Ror_Operator - | Iir_Kind_Addition_Operator - | Iir_Kind_Substraction_Operator - | Iir_Kind_Concatenation_Operator - | Iir_Kind_Multiplication_Operator - | Iir_Kind_Division_Operator - | Iir_Kind_Modulus_Operator - | Iir_Kind_Remainder_Operator - | Iir_Kind_Exponentiation_Operator - | Iir_Kind_Function_Call - | Iir_Kind_Aggregate - | Iir_Kind_Parenthesis_Expression - | Iir_Kind_Qualified_Expression - | Iir_Kind_Type_Conversion - | Iir_Kind_Allocator_By_Expression - | Iir_Kind_Allocator_By_Subtype - | Iir_Kind_Selected_Element - | Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference - | Iir_Kind_Slice_Name - | Iir_Kind_Indexed_Name - | Iir_Kind_Psl_Expression - | Iir_Kind_Psl_Default_Clock - | Iir_Kind_Concurrent_Procedure_Call_Statement - | Iir_Kind_Null_Statement - | Iir_Kind_Variable_Assignment_Statement - | Iir_Kind_Return_Statement - | Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement - | Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement - | Iir_Kind_Case_Statement - | Iir_Kind_Procedure_Call_Statement - | Iir_Kind_Character_Literal - | Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Operator_Symbol - | Iir_Kind_Selected_By_All_Name - | Iir_Kind_Parenthesis_Name - | Iir_Kind_Base_Attribute - | Iir_Kind_Left_Type_Attribute - | Iir_Kind_Right_Type_Attribute - | Iir_Kind_High_Type_Attribute - | Iir_Kind_Low_Type_Attribute - | Iir_Kind_Ascending_Type_Attribute - | Iir_Kind_Image_Attribute - | Iir_Kind_Value_Attribute - | Iir_Kind_Pos_Attribute - | Iir_Kind_Val_Attribute - | Iir_Kind_Succ_Attribute - | Iir_Kind_Pred_Attribute - | Iir_Kind_Leftof_Attribute - | Iir_Kind_Rightof_Attribute - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute - | Iir_Kind_Event_Attribute - | Iir_Kind_Active_Attribute - | Iir_Kind_Last_Event_Attribute - | Iir_Kind_Last_Active_Attribute - | Iir_Kind_Last_Value_Attribute - | Iir_Kind_Driving_Attribute - | Iir_Kind_Driving_Value_Attribute - | Iir_Kind_Behavior_Attribute - | Iir_Kind_Structure_Attribute - | Iir_Kind_Simple_Name_Attribute - | Iir_Kind_Instance_Name_Attribute - | Iir_Kind_Path_Name_Attribute - | Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute - | Iir_Kind_Attribute_Name => - return Format_Short; - when Iir_Kind_Design_File - | Iir_Kind_Design_Unit - | Iir_Kind_Bit_String_Literal - | Iir_Kind_Block_Header - | Iir_Kind_Binding_Indication - | Iir_Kind_Signature - | Iir_Kind_Attribute_Specification - | Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Subtype_Definition - | Iir_Kind_Scalar_Nature_Definition - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Package_Header - | Iir_Kind_Unit_Declaration - | Iir_Kind_Library_Declaration - | Iir_Kind_Component_Declaration - | Iir_Kind_Psl_Declaration - | Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Enumeration_Literal - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_File_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Interface_Package_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement - | Iir_Kind_Component_Instantiation_Statement - | Iir_Kind_Simple_Simultaneous_Statement - | Iir_Kind_Signal_Assignment_Statement - | Iir_Kind_Assertion_Statement - | Iir_Kind_Report_Statement - | Iir_Kind_Wait_Statement - | Iir_Kind_If_Statement - | Iir_Kind_Elsif => - return Format_Medium; - when Iir_Kind_Floating_Point_Literal - | Iir_Kind_Physical_Fp_Literal => - return Format_Fp; - when Iir_Kind_Integer_Literal - | Iir_Kind_Physical_Int_Literal => - return Format_Int; - end case; - end Get_Format; - - function Get_First_Design_Unit (Design : Iir) return Iir is - begin - pragma Assert (Design /= Null_Iir); - pragma Assert (Has_First_Design_Unit (Get_Kind (Design))); - return Get_Field5 (Design); - end Get_First_Design_Unit; - - procedure Set_First_Design_Unit (Design : Iir; Chain : Iir) is - begin - pragma Assert (Design /= Null_Iir); - pragma Assert (Has_First_Design_Unit (Get_Kind (Design))); - Set_Field5 (Design, Chain); - end Set_First_Design_Unit; - - function Get_Last_Design_Unit (Design : Iir) return Iir is - begin - pragma Assert (Design /= Null_Iir); - pragma Assert (Has_Last_Design_Unit (Get_Kind (Design))); - return Get_Field6 (Design); - end Get_Last_Design_Unit; - - procedure Set_Last_Design_Unit (Design : Iir; Chain : Iir) is - begin - pragma Assert (Design /= Null_Iir); - pragma Assert (Has_Last_Design_Unit (Get_Kind (Design))); - Set_Field6 (Design, Chain); - end Set_Last_Design_Unit; - - function Get_Library_Declaration (Design : Iir) return Iir is - begin - pragma Assert (Design /= Null_Iir); - pragma Assert (Has_Library_Declaration (Get_Kind (Design))); - return Get_Field1 (Design); - end Get_Library_Declaration; - - procedure Set_Library_Declaration (Design : Iir; Library : Iir) is - begin - pragma Assert (Design /= Null_Iir); - pragma Assert (Has_Library_Declaration (Get_Kind (Design))); - Set_Field1 (Design, Library); - end Set_Library_Declaration; - - function Get_File_Time_Stamp (Design : Iir) return Time_Stamp_Id is - begin - pragma Assert (Design /= Null_Iir); - pragma Assert (Has_File_Time_Stamp (Get_Kind (Design))); - return Iir_To_Time_Stamp_Id (Get_Field4 (Design)); - end Get_File_Time_Stamp; - - procedure Set_File_Time_Stamp (Design : Iir; Stamp : Time_Stamp_Id) is - begin - pragma Assert (Design /= Null_Iir); - pragma Assert (Has_File_Time_Stamp (Get_Kind (Design))); - Set_Field4 (Design, Time_Stamp_Id_To_Iir (Stamp)); - end Set_File_Time_Stamp; - - function Get_Analysis_Time_Stamp (Design : Iir) return Time_Stamp_Id is - begin - pragma Assert (Design /= Null_Iir); - pragma Assert (Has_Analysis_Time_Stamp (Get_Kind (Design))); - return Iir_To_Time_Stamp_Id (Get_Field3 (Design)); - end Get_Analysis_Time_Stamp; - - procedure Set_Analysis_Time_Stamp (Design : Iir; Stamp : Time_Stamp_Id) is - begin - pragma Assert (Design /= Null_Iir); - pragma Assert (Has_Analysis_Time_Stamp (Get_Kind (Design))); - Set_Field3 (Design, Time_Stamp_Id_To_Iir (Stamp)); - end Set_Analysis_Time_Stamp; - - function Get_Library (File : Iir_Design_File) return Iir is - begin - pragma Assert (File /= Null_Iir); - pragma Assert (Has_Library (Get_Kind (File))); - return Get_Field0 (File); - end Get_Library; - - procedure Set_Library (File : Iir_Design_File; Lib : Iir) is - begin - pragma Assert (File /= Null_Iir); - pragma Assert (Has_Library (Get_Kind (File))); - Set_Field0 (File, Lib); - end Set_Library; - - function Get_File_Dependence_List (File : Iir_Design_File) return Iir_List - is - begin - pragma Assert (File /= Null_Iir); - pragma Assert (Has_File_Dependence_List (Get_Kind (File))); - return Iir_To_Iir_List (Get_Field1 (File)); - end Get_File_Dependence_List; - - procedure Set_File_Dependence_List (File : Iir_Design_File; Lst : Iir_List) - is - begin - pragma Assert (File /= Null_Iir); - pragma Assert (Has_File_Dependence_List (Get_Kind (File))); - Set_Field1 (File, Iir_List_To_Iir (Lst)); - end Set_File_Dependence_List; - - function Get_Design_File_Filename (File : Iir_Design_File) return Name_Id - is - begin - pragma Assert (File /= Null_Iir); - pragma Assert (Has_Design_File_Filename (Get_Kind (File))); - return Name_Id'Val (Get_Field12 (File)); - end Get_Design_File_Filename; - - procedure Set_Design_File_Filename (File : Iir_Design_File; Name : Name_Id) - is - begin - pragma Assert (File /= Null_Iir); - pragma Assert (Has_Design_File_Filename (Get_Kind (File))); - Set_Field12 (File, Name_Id'Pos (Name)); - end Set_Design_File_Filename; - - function Get_Design_File_Directory (File : Iir_Design_File) return Name_Id - is - begin - pragma Assert (File /= Null_Iir); - pragma Assert (Has_Design_File_Directory (Get_Kind (File))); - return Name_Id'Val (Get_Field11 (File)); - end Get_Design_File_Directory; - - procedure Set_Design_File_Directory (File : Iir_Design_File; Dir : Name_Id) - is - begin - pragma Assert (File /= Null_Iir); - pragma Assert (Has_Design_File_Directory (Get_Kind (File))); - Set_Field11 (File, Name_Id'Pos (Dir)); - end Set_Design_File_Directory; - - function Get_Design_File (Unit : Iir_Design_Unit) return Iir is - begin - pragma Assert (Unit /= Null_Iir); - pragma Assert (Has_Design_File (Get_Kind (Unit))); - return Get_Field0 (Unit); - end Get_Design_File; - - procedure Set_Design_File (Unit : Iir_Design_Unit; File : Iir) is - begin - pragma Assert (Unit /= Null_Iir); - pragma Assert (Has_Design_File (Get_Kind (Unit))); - Set_Field0 (Unit, File); - end Set_Design_File; - - function Get_Design_File_Chain (Library : Iir) return Iir is - begin - pragma Assert (Library /= Null_Iir); - pragma Assert (Has_Design_File_Chain (Get_Kind (Library))); - return Get_Field1 (Library); - end Get_Design_File_Chain; - - procedure Set_Design_File_Chain (Library : Iir; Chain : Iir) is - begin - pragma Assert (Library /= Null_Iir); - pragma Assert (Has_Design_File_Chain (Get_Kind (Library))); - Set_Field1 (Library, Chain); - end Set_Design_File_Chain; - - function Get_Library_Directory (Library : Iir) return Name_Id is - begin - pragma Assert (Library /= Null_Iir); - pragma Assert (Has_Library_Directory (Get_Kind (Library))); - return Name_Id'Val (Get_Field11 (Library)); - end Get_Library_Directory; - - procedure Set_Library_Directory (Library : Iir; Dir : Name_Id) is - begin - pragma Assert (Library /= Null_Iir); - pragma Assert (Has_Library_Directory (Get_Kind (Library))); - Set_Field11 (Library, Name_Id'Pos (Dir)); - end Set_Library_Directory; - - function Get_Date (Target : Iir) return Date_Type is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Date (Get_Kind (Target))); - return Date_Type'Val (Get_Field10 (Target)); - end Get_Date; - - procedure Set_Date (Target : Iir; Date : Date_Type) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Date (Get_Kind (Target))); - Set_Field10 (Target, Date_Type'Pos (Date)); - end Set_Date; - - function Get_Context_Items (Design_Unit : Iir) return Iir is - begin - pragma Assert (Design_Unit /= Null_Iir); - pragma Assert (Has_Context_Items (Get_Kind (Design_Unit))); - return Get_Field1 (Design_Unit); - end Get_Context_Items; - - procedure Set_Context_Items (Design_Unit : Iir; Items_Chain : Iir) is - begin - pragma Assert (Design_Unit /= Null_Iir); - pragma Assert (Has_Context_Items (Get_Kind (Design_Unit))); - Set_Field1 (Design_Unit, Items_Chain); - end Set_Context_Items; - - function Get_Dependence_List (Unit : Iir) return Iir_List is - begin - pragma Assert (Unit /= Null_Iir); - pragma Assert (Has_Dependence_List (Get_Kind (Unit))); - return Iir_To_Iir_List (Get_Field8 (Unit)); - end Get_Dependence_List; - - procedure Set_Dependence_List (Unit : Iir; List : Iir_List) is - begin - pragma Assert (Unit /= Null_Iir); - pragma Assert (Has_Dependence_List (Get_Kind (Unit))); - Set_Field8 (Unit, Iir_List_To_Iir (List)); - end Set_Dependence_List; - - function Get_Analysis_Checks_List (Unit : Iir) return Iir_List is - begin - pragma Assert (Unit /= Null_Iir); - pragma Assert (Has_Analysis_Checks_List (Get_Kind (Unit))); - return Iir_To_Iir_List (Get_Field9 (Unit)); - end Get_Analysis_Checks_List; - - procedure Set_Analysis_Checks_List (Unit : Iir; List : Iir_List) is - begin - pragma Assert (Unit /= Null_Iir); - pragma Assert (Has_Analysis_Checks_List (Get_Kind (Unit))); - Set_Field9 (Unit, Iir_List_To_Iir (List)); - end Set_Analysis_Checks_List; - - function Get_Date_State (Unit : Iir_Design_Unit) return Date_State_Type is - begin - pragma Assert (Unit /= Null_Iir); - pragma Assert (Has_Date_State (Get_Kind (Unit))); - return Date_State_Type'Val (Get_State1 (Unit)); - end Get_Date_State; - - procedure Set_Date_State (Unit : Iir_Design_Unit; State : Date_State_Type) - is - begin - pragma Assert (Unit /= Null_Iir); - pragma Assert (Has_Date_State (Get_Kind (Unit))); - Set_State1 (Unit, Date_State_Type'Pos (State)); - end Set_Date_State; - - function Get_Guarded_Target_State (Stmt : Iir) return Tri_State_Type is - begin - pragma Assert (Stmt /= Null_Iir); - pragma Assert (Has_Guarded_Target_State (Get_Kind (Stmt))); - return Tri_State_Type'Val (Get_State3 (Stmt)); - end Get_Guarded_Target_State; - - procedure Set_Guarded_Target_State (Stmt : Iir; State : Tri_State_Type) is - begin - pragma Assert (Stmt /= Null_Iir); - pragma Assert (Has_Guarded_Target_State (Get_Kind (Stmt))); - Set_State3 (Stmt, Tri_State_Type'Pos (State)); - end Set_Guarded_Target_State; - - function Get_Library_Unit (Design_Unit : Iir_Design_Unit) return Iir is - begin - pragma Assert (Design_Unit /= Null_Iir); - pragma Assert (Has_Library_Unit (Get_Kind (Design_Unit))); - return Get_Field5 (Design_Unit); - end Get_Library_Unit; - - procedure Set_Library_Unit (Design_Unit : Iir_Design_Unit; Lib_Unit : Iir) - is - begin - pragma Assert (Design_Unit /= Null_Iir); - pragma Assert (Has_Library_Unit (Get_Kind (Design_Unit))); - Set_Field5 (Design_Unit, Lib_Unit); - end Set_Library_Unit; - - function Get_Hash_Chain (Design_Unit : Iir_Design_Unit) return Iir is - begin - pragma Assert (Design_Unit /= Null_Iir); - pragma Assert (Has_Hash_Chain (Get_Kind (Design_Unit))); - return Get_Field7 (Design_Unit); - end Get_Hash_Chain; - - procedure Set_Hash_Chain (Design_Unit : Iir_Design_Unit; Chain : Iir) is - begin - pragma Assert (Design_Unit /= Null_Iir); - pragma Assert (Has_Hash_Chain (Get_Kind (Design_Unit))); - Set_Field7 (Design_Unit, Chain); - end Set_Hash_Chain; - - function Get_Design_Unit_Source_Pos (Design_Unit : Iir) return Source_Ptr - is - begin - pragma Assert (Design_Unit /= Null_Iir); - pragma Assert (Has_Design_Unit_Source_Pos (Get_Kind (Design_Unit))); - return Iir_To_Source_Ptr (Get_Field4 (Design_Unit)); - end Get_Design_Unit_Source_Pos; - - procedure Set_Design_Unit_Source_Pos (Design_Unit : Iir; Pos : Source_Ptr) - is - begin - pragma Assert (Design_Unit /= Null_Iir); - pragma Assert (Has_Design_Unit_Source_Pos (Get_Kind (Design_Unit))); - Set_Field4 (Design_Unit, Source_Ptr_To_Iir (Pos)); - end Set_Design_Unit_Source_Pos; - - function Get_Design_Unit_Source_Line (Design_Unit : Iir) return Int32 is - begin - pragma Assert (Design_Unit /= Null_Iir); - pragma Assert (Has_Design_Unit_Source_Line (Get_Kind (Design_Unit))); - return Iir_To_Int32 (Get_Field11 (Design_Unit)); - end Get_Design_Unit_Source_Line; - - procedure Set_Design_Unit_Source_Line (Design_Unit : Iir; Line : Int32) is - begin - pragma Assert (Design_Unit /= Null_Iir); - pragma Assert (Has_Design_Unit_Source_Line (Get_Kind (Design_Unit))); - Set_Field11 (Design_Unit, Int32_To_Iir (Line)); - end Set_Design_Unit_Source_Line; - - function Get_Design_Unit_Source_Col (Design_Unit : Iir) return Int32 is - begin - pragma Assert (Design_Unit /= Null_Iir); - pragma Assert (Has_Design_Unit_Source_Col (Get_Kind (Design_Unit))); - return Iir_To_Int32 (Get_Field12 (Design_Unit)); - end Get_Design_Unit_Source_Col; - - procedure Set_Design_Unit_Source_Col (Design_Unit : Iir; Line : Int32) is - begin - pragma Assert (Design_Unit /= Null_Iir); - pragma Assert (Has_Design_Unit_Source_Col (Get_Kind (Design_Unit))); - Set_Field12 (Design_Unit, Int32_To_Iir (Line)); - end Set_Design_Unit_Source_Col; - - function Get_Value (Lit : Iir) return Iir_Int64 is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Value (Get_Kind (Lit))); - return Get_Int64 (Lit); - end Get_Value; - - procedure Set_Value (Lit : Iir; Val : Iir_Int64) is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Value (Get_Kind (Lit))); - Set_Int64 (Lit, Val); - end Set_Value; - - function Get_Enum_Pos (Lit : Iir) return Iir_Int32 is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Enum_Pos (Get_Kind (Lit))); - return Iir_Int32'Val (Get_Field10 (Lit)); - end Get_Enum_Pos; - - procedure Set_Enum_Pos (Lit : Iir; Val : Iir_Int32) is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Enum_Pos (Get_Kind (Lit))); - Set_Field10 (Lit, Iir_Int32'Pos (Val)); - end Set_Enum_Pos; - - function Get_Physical_Literal (Unit : Iir) return Iir is - begin - pragma Assert (Unit /= Null_Iir); - pragma Assert (Has_Physical_Literal (Get_Kind (Unit))); - return Get_Field6 (Unit); - end Get_Physical_Literal; - - procedure Set_Physical_Literal (Unit : Iir; Lit : Iir) is - begin - pragma Assert (Unit /= Null_Iir); - pragma Assert (Has_Physical_Literal (Get_Kind (Unit))); - Set_Field6 (Unit, Lit); - end Set_Physical_Literal; - - function Get_Physical_Unit_Value (Unit : Iir) return Iir is - begin - pragma Assert (Unit /= Null_Iir); - pragma Assert (Has_Physical_Unit_Value (Get_Kind (Unit))); - return Get_Field7 (Unit); - end Get_Physical_Unit_Value; - - procedure Set_Physical_Unit_Value (Unit : Iir; Lit : Iir) is - begin - pragma Assert (Unit /= Null_Iir); - pragma Assert (Has_Physical_Unit_Value (Get_Kind (Unit))); - Set_Field7 (Unit, Lit); - end Set_Physical_Unit_Value; - - function Get_Fp_Value (Lit : Iir) return Iir_Fp64 is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Fp_Value (Get_Kind (Lit))); - return Get_Fp64 (Lit); - end Get_Fp_Value; - - procedure Set_Fp_Value (Lit : Iir; Val : Iir_Fp64) is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Fp_Value (Get_Kind (Lit))); - Set_Fp64 (Lit, Val); - end Set_Fp_Value; - - function Get_Enumeration_Decl (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Enumeration_Decl (Get_Kind (Target))); - return Get_Field6 (Target); - end Get_Enumeration_Decl; - - procedure Set_Enumeration_Decl (Target : Iir; Lit : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Enumeration_Decl (Get_Kind (Target))); - Set_Field6 (Target, Lit); - end Set_Enumeration_Decl; - - function Get_Simple_Aggregate_List (Target : Iir) return Iir_List is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Simple_Aggregate_List (Get_Kind (Target))); - return Iir_To_Iir_List (Get_Field3 (Target)); - end Get_Simple_Aggregate_List; - - procedure Set_Simple_Aggregate_List (Target : Iir; List : Iir_List) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Simple_Aggregate_List (Get_Kind (Target))); - Set_Field3 (Target, Iir_List_To_Iir (List)); - end Set_Simple_Aggregate_List; - - function Get_Bit_String_Base (Lit : Iir) return Base_Type is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Bit_String_Base (Get_Kind (Lit))); - return Base_Type'Val (Get_Field8 (Lit)); - end Get_Bit_String_Base; - - procedure Set_Bit_String_Base (Lit : Iir; Base : Base_Type) is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Bit_String_Base (Get_Kind (Lit))); - Set_Field8 (Lit, Base_Type'Pos (Base)); - end Set_Bit_String_Base; - - function Get_Bit_String_0 (Lit : Iir) return Iir is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Bit_String_0 (Get_Kind (Lit))); - return Get_Field6 (Lit); - end Get_Bit_String_0; - - procedure Set_Bit_String_0 (Lit : Iir; El : Iir) is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Bit_String_0 (Get_Kind (Lit))); - Set_Field6 (Lit, El); - end Set_Bit_String_0; - - function Get_Bit_String_1 (Lit : Iir) return Iir is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Bit_String_1 (Get_Kind (Lit))); - return Get_Field7 (Lit); - end Get_Bit_String_1; - - procedure Set_Bit_String_1 (Lit : Iir; El : Iir) is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Bit_String_1 (Get_Kind (Lit))); - Set_Field7 (Lit, El); - end Set_Bit_String_1; - - function Get_Literal_Origin (Lit : Iir) return Iir is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Literal_Origin (Get_Kind (Lit))); - return Get_Field2 (Lit); - end Get_Literal_Origin; - - procedure Set_Literal_Origin (Lit : Iir; Orig : Iir) is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Literal_Origin (Get_Kind (Lit))); - Set_Field2 (Lit, Orig); - end Set_Literal_Origin; - - function Get_Range_Origin (Lit : Iir) return Iir is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Range_Origin (Get_Kind (Lit))); - return Get_Field4 (Lit); - end Get_Range_Origin; - - procedure Set_Range_Origin (Lit : Iir; Orig : Iir) is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Range_Origin (Get_Kind (Lit))); - Set_Field4 (Lit, Orig); - end Set_Range_Origin; - - function Get_Literal_Subtype (Lit : Iir) return Iir is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Literal_Subtype (Get_Kind (Lit))); - return Get_Field5 (Lit); - end Get_Literal_Subtype; - - procedure Set_Literal_Subtype (Lit : Iir; Atype : Iir) is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Literal_Subtype (Get_Kind (Lit))); - Set_Field5 (Lit, Atype); - end Set_Literal_Subtype; - - function Get_Entity_Class (Target : Iir) return Token_Type is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Entity_Class (Get_Kind (Target))); - return Iir_To_Token_Type (Get_Field3 (Target)); - end Get_Entity_Class; - - procedure Set_Entity_Class (Target : Iir; Kind : Token_Type) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Entity_Class (Get_Kind (Target))); - Set_Field3 (Target, Token_Type_To_Iir (Kind)); - end Set_Entity_Class; - - function Get_Entity_Name_List (Target : Iir) return Iir_List is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Entity_Name_List (Get_Kind (Target))); - return Iir_To_Iir_List (Get_Field1 (Target)); - end Get_Entity_Name_List; - - procedure Set_Entity_Name_List (Target : Iir; Names : Iir_List) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Entity_Name_List (Get_Kind (Target))); - Set_Field1 (Target, Iir_List_To_Iir (Names)); - end Set_Entity_Name_List; - - function Get_Attribute_Designator (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Attribute_Designator (Get_Kind (Target))); - return Get_Field6 (Target); - end Get_Attribute_Designator; - - procedure Set_Attribute_Designator (Target : Iir; Designator : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Attribute_Designator (Get_Kind (Target))); - Set_Field6 (Target, Designator); - end Set_Attribute_Designator; - - function Get_Attribute_Specification_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Attribute_Specification_Chain (Get_Kind (Target))); - return Get_Field7 (Target); - end Get_Attribute_Specification_Chain; - - procedure Set_Attribute_Specification_Chain (Target : Iir; Chain : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Attribute_Specification_Chain (Get_Kind (Target))); - Set_Field7 (Target, Chain); - end Set_Attribute_Specification_Chain; - - function Get_Attribute_Specification (Val : Iir) return Iir is - begin - pragma Assert (Val /= Null_Iir); - pragma Assert (Has_Attribute_Specification (Get_Kind (Val))); - return Get_Field4 (Val); - end Get_Attribute_Specification; - - procedure Set_Attribute_Specification (Val : Iir; Attr : Iir) is - begin - pragma Assert (Val /= Null_Iir); - pragma Assert (Has_Attribute_Specification (Get_Kind (Val))); - Set_Field4 (Val, Attr); - end Set_Attribute_Specification; - - function Get_Signal_List (Target : Iir) return Iir_List is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Signal_List (Get_Kind (Target))); - return Iir_To_Iir_List (Get_Field3 (Target)); - end Get_Signal_List; - - procedure Set_Signal_List (Target : Iir; List : Iir_List) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Signal_List (Get_Kind (Target))); - Set_Field3 (Target, Iir_List_To_Iir (List)); - end Set_Signal_List; - - function Get_Designated_Entity (Val : Iir_Attribute_Value) return Iir is - begin - pragma Assert (Val /= Null_Iir); - pragma Assert (Has_Designated_Entity (Get_Kind (Val))); - return Get_Field3 (Val); - end Get_Designated_Entity; - - procedure Set_Designated_Entity (Val : Iir_Attribute_Value; Entity : Iir) - is - begin - pragma Assert (Val /= Null_Iir); - pragma Assert (Has_Designated_Entity (Get_Kind (Val))); - Set_Field3 (Val, Entity); - end Set_Designated_Entity; - - function Get_Formal (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Formal (Get_Kind (Target))); - return Get_Field1 (Target); - end Get_Formal; - - procedure Set_Formal (Target : Iir; Formal : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Formal (Get_Kind (Target))); - Set_Field1 (Target, Formal); - end Set_Formal; - - function Get_Actual (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Actual (Get_Kind (Target))); - return Get_Field3 (Target); - end Get_Actual; - - procedure Set_Actual (Target : Iir; Actual : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Actual (Get_Kind (Target))); - Set_Field3 (Target, Actual); - end Set_Actual; - - function Get_In_Conversion (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_In_Conversion (Get_Kind (Target))); - return Get_Field4 (Target); - end Get_In_Conversion; - - procedure Set_In_Conversion (Target : Iir; Conv : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_In_Conversion (Get_Kind (Target))); - Set_Field4 (Target, Conv); - end Set_In_Conversion; - - function Get_Out_Conversion (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Out_Conversion (Get_Kind (Target))); - return Get_Field5 (Target); - end Get_Out_Conversion; - - procedure Set_Out_Conversion (Target : Iir; Conv : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Out_Conversion (Get_Kind (Target))); - Set_Field5 (Target, Conv); - end Set_Out_Conversion; - - function Get_Whole_Association_Flag (Target : Iir) return Boolean is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Whole_Association_Flag (Get_Kind (Target))); - return Get_Flag1 (Target); - end Get_Whole_Association_Flag; - - procedure Set_Whole_Association_Flag (Target : Iir; Flag : Boolean) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Whole_Association_Flag (Get_Kind (Target))); - Set_Flag1 (Target, Flag); - end Set_Whole_Association_Flag; - - function Get_Collapse_Signal_Flag (Target : Iir) return Boolean is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Collapse_Signal_Flag (Get_Kind (Target))); - return Get_Flag2 (Target); - end Get_Collapse_Signal_Flag; - - procedure Set_Collapse_Signal_Flag (Target : Iir; Flag : Boolean) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Collapse_Signal_Flag (Get_Kind (Target))); - Set_Flag2 (Target, Flag); - end Set_Collapse_Signal_Flag; - - function Get_Artificial_Flag (Target : Iir) return Boolean is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Artificial_Flag (Get_Kind (Target))); - return Get_Flag3 (Target); - end Get_Artificial_Flag; - - procedure Set_Artificial_Flag (Target : Iir; Flag : Boolean) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Artificial_Flag (Get_Kind (Target))); - Set_Flag3 (Target, Flag); - end Set_Artificial_Flag; - - function Get_Open_Flag (Target : Iir) return Boolean is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Open_Flag (Get_Kind (Target))); - return Get_Flag3 (Target); - end Get_Open_Flag; - - procedure Set_Open_Flag (Target : Iir; Flag : Boolean) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Open_Flag (Get_Kind (Target))); - Set_Flag3 (Target, Flag); - end Set_Open_Flag; - - function Get_After_Drivers_Flag (Target : Iir) return Boolean is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_After_Drivers_Flag (Get_Kind (Target))); - return Get_Flag5 (Target); - end Get_After_Drivers_Flag; - - procedure Set_After_Drivers_Flag (Target : Iir; Flag : Boolean) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_After_Drivers_Flag (Get_Kind (Target))); - Set_Flag5 (Target, Flag); - end Set_After_Drivers_Flag; - - function Get_We_Value (We : Iir_Waveform_Element) return Iir is - begin - pragma Assert (We /= Null_Iir); - pragma Assert (Has_We_Value (Get_Kind (We))); - return Get_Field1 (We); - end Get_We_Value; - - procedure Set_We_Value (We : Iir_Waveform_Element; An_Iir : Iir) is - begin - pragma Assert (We /= Null_Iir); - pragma Assert (Has_We_Value (Get_Kind (We))); - Set_Field1 (We, An_Iir); - end Set_We_Value; - - function Get_Time (We : Iir_Waveform_Element) return Iir is - begin - pragma Assert (We /= Null_Iir); - pragma Assert (Has_Time (Get_Kind (We))); - return Get_Field3 (We); - end Get_Time; - - procedure Set_Time (We : Iir_Waveform_Element; An_Iir : Iir) is - begin - pragma Assert (We /= Null_Iir); - pragma Assert (Has_Time (Get_Kind (We))); - Set_Field3 (We, An_Iir); - end Set_Time; - - function Get_Associated_Expr (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Associated_Expr (Get_Kind (Target))); - return Get_Field3 (Target); - end Get_Associated_Expr; - - procedure Set_Associated_Expr (Target : Iir; Associated : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Associated_Expr (Get_Kind (Target))); - Set_Field3 (Target, Associated); - end Set_Associated_Expr; - - function Get_Associated_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Associated_Chain (Get_Kind (Target))); - return Get_Field4 (Target); - end Get_Associated_Chain; - - procedure Set_Associated_Chain (Target : Iir; Associated : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Associated_Chain (Get_Kind (Target))); - Set_Field4 (Target, Associated); - end Set_Associated_Chain; - - function Get_Choice_Name (Choice : Iir) return Iir is - begin - pragma Assert (Choice /= Null_Iir); - pragma Assert (Has_Choice_Name (Get_Kind (Choice))); - return Get_Field5 (Choice); - end Get_Choice_Name; - - procedure Set_Choice_Name (Choice : Iir; Name : Iir) is - begin - pragma Assert (Choice /= Null_Iir); - pragma Assert (Has_Choice_Name (Get_Kind (Choice))); - Set_Field5 (Choice, Name); - end Set_Choice_Name; - - function Get_Choice_Expression (Choice : Iir) return Iir is - begin - pragma Assert (Choice /= Null_Iir); - pragma Assert (Has_Choice_Expression (Get_Kind (Choice))); - return Get_Field5 (Choice); - end Get_Choice_Expression; - - procedure Set_Choice_Expression (Choice : Iir; Name : Iir) is - begin - pragma Assert (Choice /= Null_Iir); - pragma Assert (Has_Choice_Expression (Get_Kind (Choice))); - Set_Field5 (Choice, Name); - end Set_Choice_Expression; - - function Get_Choice_Range (Choice : Iir) return Iir is - begin - pragma Assert (Choice /= Null_Iir); - pragma Assert (Has_Choice_Range (Get_Kind (Choice))); - return Get_Field5 (Choice); - end Get_Choice_Range; - - procedure Set_Choice_Range (Choice : Iir; Name : Iir) is - begin - pragma Assert (Choice /= Null_Iir); - pragma Assert (Has_Choice_Range (Get_Kind (Choice))); - Set_Field5 (Choice, Name); - end Set_Choice_Range; - - function Get_Same_Alternative_Flag (Target : Iir) return Boolean is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Same_Alternative_Flag (Get_Kind (Target))); - return Get_Flag1 (Target); - end Get_Same_Alternative_Flag; - - procedure Set_Same_Alternative_Flag (Target : Iir; Val : Boolean) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Same_Alternative_Flag (Get_Kind (Target))); - Set_Flag1 (Target, Val); - end Set_Same_Alternative_Flag; - - function Get_Architecture (Target : Iir_Entity_Aspect_Entity) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Architecture (Get_Kind (Target))); - return Get_Field3 (Target); - end Get_Architecture; - - procedure Set_Architecture (Target : Iir_Entity_Aspect_Entity; Arch : Iir) - is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Architecture (Get_Kind (Target))); - Set_Field3 (Target, Arch); - end Set_Architecture; - - function Get_Block_Specification (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Block_Specification (Get_Kind (Target))); - return Get_Field5 (Target); - end Get_Block_Specification; - - procedure Set_Block_Specification (Target : Iir; Block : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Block_Specification (Get_Kind (Target))); - Set_Field5 (Target, Block); - end Set_Block_Specification; - - function Get_Prev_Block_Configuration (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Prev_Block_Configuration (Get_Kind (Target))); - return Get_Field4 (Target); - end Get_Prev_Block_Configuration; - - procedure Set_Prev_Block_Configuration (Target : Iir; Block : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Prev_Block_Configuration (Get_Kind (Target))); - Set_Field4 (Target, Block); - end Set_Prev_Block_Configuration; - - function Get_Configuration_Item_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Configuration_Item_Chain (Get_Kind (Target))); - return Get_Field3 (Target); - end Get_Configuration_Item_Chain; - - procedure Set_Configuration_Item_Chain (Target : Iir; Chain : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Configuration_Item_Chain (Get_Kind (Target))); - Set_Field3 (Target, Chain); - end Set_Configuration_Item_Chain; - - function Get_Attribute_Value_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Attribute_Value_Chain (Get_Kind (Target))); - return Get_Field4 (Target); - end Get_Attribute_Value_Chain; - - procedure Set_Attribute_Value_Chain (Target : Iir; Chain : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Attribute_Value_Chain (Get_Kind (Target))); - Set_Field4 (Target, Chain); - end Set_Attribute_Value_Chain; - - function Get_Spec_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Spec_Chain (Get_Kind (Target))); - return Get_Field0 (Target); - end Get_Spec_Chain; - - procedure Set_Spec_Chain (Target : Iir; Chain : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Spec_Chain (Get_Kind (Target))); - Set_Field0 (Target, Chain); - end Set_Spec_Chain; - - function Get_Attribute_Value_Spec_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Attribute_Value_Spec_Chain (Get_Kind (Target))); - return Get_Field4 (Target); - end Get_Attribute_Value_Spec_Chain; - - procedure Set_Attribute_Value_Spec_Chain (Target : Iir; Chain : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Attribute_Value_Spec_Chain (Get_Kind (Target))); - Set_Field4 (Target, Chain); - end Set_Attribute_Value_Spec_Chain; - - function Get_Entity_Name (Arch : Iir) return Iir is - begin - pragma Assert (Arch /= Null_Iir); - pragma Assert (Has_Entity_Name (Get_Kind (Arch))); - return Get_Field2 (Arch); - end Get_Entity_Name; - - procedure Set_Entity_Name (Arch : Iir; Entity : Iir) is - begin - pragma Assert (Arch /= Null_Iir); - pragma Assert (Has_Entity_Name (Get_Kind (Arch))); - Set_Field2 (Arch, Entity); - end Set_Entity_Name; - - function Get_Package (Package_Body : Iir) return Iir is - begin - pragma Assert (Package_Body /= Null_Iir); - pragma Assert (Has_Package (Get_Kind (Package_Body))); - return Get_Field4 (Package_Body); - end Get_Package; - - procedure Set_Package (Package_Body : Iir; Decl : Iir) is - begin - pragma Assert (Package_Body /= Null_Iir); - pragma Assert (Has_Package (Get_Kind (Package_Body))); - Set_Field4 (Package_Body, Decl); - end Set_Package; - - function Get_Package_Body (Pkg : Iir) return Iir is - begin - pragma Assert (Pkg /= Null_Iir); - pragma Assert (Has_Package_Body (Get_Kind (Pkg))); - return Get_Field2 (Pkg); - end Get_Package_Body; - - procedure Set_Package_Body (Pkg : Iir; Decl : Iir) is - begin - pragma Assert (Pkg /= Null_Iir); - pragma Assert (Has_Package_Body (Get_Kind (Pkg))); - Set_Field2 (Pkg, Decl); - end Set_Package_Body; - - function Get_Need_Body (Decl : Iir_Package_Declaration) return Boolean is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Need_Body (Get_Kind (Decl))); - return Get_Flag1 (Decl); - end Get_Need_Body; - - procedure Set_Need_Body (Decl : Iir_Package_Declaration; Flag : Boolean) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Need_Body (Get_Kind (Decl))); - Set_Flag1 (Decl, Flag); - end Set_Need_Body; - - function Get_Block_Configuration (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Block_Configuration (Get_Kind (Target))); - return Get_Field5 (Target); - end Get_Block_Configuration; - - procedure Set_Block_Configuration (Target : Iir; Block : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Block_Configuration (Get_Kind (Target))); - Set_Field5 (Target, Block); - end Set_Block_Configuration; - - function Get_Concurrent_Statement_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Concurrent_Statement_Chain (Get_Kind (Target))); - return Get_Field5 (Target); - end Get_Concurrent_Statement_Chain; - - procedure Set_Concurrent_Statement_Chain (Target : Iir; First : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Concurrent_Statement_Chain (Get_Kind (Target))); - Set_Field5 (Target, First); - end Set_Concurrent_Statement_Chain; - - function Get_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Chain (Get_Kind (Target))); - return Get_Field2 (Target); - end Get_Chain; - - procedure Set_Chain (Target : Iir; Chain : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Chain (Get_Kind (Target))); - Set_Field2 (Target, Chain); - end Set_Chain; - - function Get_Port_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Port_Chain (Get_Kind (Target))); - return Get_Field7 (Target); - end Get_Port_Chain; - - procedure Set_Port_Chain (Target : Iir; Chain : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Port_Chain (Get_Kind (Target))); - Set_Field7 (Target, Chain); - end Set_Port_Chain; - - function Get_Generic_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Generic_Chain (Get_Kind (Target))); - return Get_Field6 (Target); - end Get_Generic_Chain; - - procedure Set_Generic_Chain (Target : Iir; Generics : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Generic_Chain (Get_Kind (Target))); - Set_Field6 (Target, Generics); - end Set_Generic_Chain; - - function Get_Type (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Type (Get_Kind (Target))); - return Get_Field1 (Target); - end Get_Type; - - procedure Set_Type (Target : Iir; Atype : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Type (Get_Kind (Target))); - Set_Field1 (Target, Atype); - end Set_Type; - - function Get_Subtype_Indication (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Subtype_Indication (Get_Kind (Target))); - return Get_Field5 (Target); - end Get_Subtype_Indication; - - procedure Set_Subtype_Indication (Target : Iir; Atype : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Subtype_Indication (Get_Kind (Target))); - Set_Field5 (Target, Atype); - end Set_Subtype_Indication; - - function Get_Discrete_Range (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Discrete_Range (Get_Kind (Target))); - return Get_Field6 (Target); - end Get_Discrete_Range; - - procedure Set_Discrete_Range (Target : Iir; Rng : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Discrete_Range (Get_Kind (Target))); - Set_Field6 (Target, Rng); - end Set_Discrete_Range; - - function Get_Type_Definition (Decl : Iir) return Iir is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Type_Definition (Get_Kind (Decl))); - return Get_Field1 (Decl); - end Get_Type_Definition; - - procedure Set_Type_Definition (Decl : Iir; Atype : Iir) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Type_Definition (Get_Kind (Decl))); - Set_Field1 (Decl, Atype); - end Set_Type_Definition; - - function Get_Subtype_Definition (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Subtype_Definition (Get_Kind (Target))); - return Get_Field4 (Target); - end Get_Subtype_Definition; - - procedure Set_Subtype_Definition (Target : Iir; Def : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Subtype_Definition (Get_Kind (Target))); - Set_Field4 (Target, Def); - end Set_Subtype_Definition; - - function Get_Nature (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Nature (Get_Kind (Target))); - return Get_Field1 (Target); - end Get_Nature; - - procedure Set_Nature (Target : Iir; Nature : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Nature (Get_Kind (Target))); - Set_Field1 (Target, Nature); - end Set_Nature; - - function Get_Mode (Target : Iir) return Iir_Mode is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Mode (Get_Kind (Target))); - return Iir_Mode'Val (Get_Odigit1 (Target)); - end Get_Mode; - - procedure Set_Mode (Target : Iir; Mode : Iir_Mode) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Mode (Get_Kind (Target))); - Set_Odigit1 (Target, Iir_Mode'Pos (Mode)); - end Set_Mode; - - function Get_Signal_Kind (Target : Iir) return Iir_Signal_Kind is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Signal_Kind (Get_Kind (Target))); - return Iir_Signal_Kind'Val (Get_State3 (Target)); - end Get_Signal_Kind; - - procedure Set_Signal_Kind (Target : Iir; Signal_Kind : Iir_Signal_Kind) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Signal_Kind (Get_Kind (Target))); - Set_State3 (Target, Iir_Signal_Kind'Pos (Signal_Kind)); - end Set_Signal_Kind; - - function Get_Base_Name (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Base_Name (Get_Kind (Target))); - return Get_Field5 (Target); - end Get_Base_Name; - - procedure Set_Base_Name (Target : Iir; Name : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Base_Name (Get_Kind (Target))); - Set_Field5 (Target, Name); - end Set_Base_Name; - - function Get_Interface_Declaration_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Interface_Declaration_Chain (Get_Kind (Target))); - return Get_Field5 (Target); - end Get_Interface_Declaration_Chain; - - procedure Set_Interface_Declaration_Chain (Target : Iir; Chain : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Interface_Declaration_Chain (Get_Kind (Target))); - Set_Field5 (Target, Chain); - end Set_Interface_Declaration_Chain; - - function Get_Subprogram_Specification (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Subprogram_Specification (Get_Kind (Target))); - return Get_Field4 (Target); - end Get_Subprogram_Specification; - - procedure Set_Subprogram_Specification (Target : Iir; Spec : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Subprogram_Specification (Get_Kind (Target))); - Set_Field4 (Target, Spec); - end Set_Subprogram_Specification; - - function Get_Sequential_Statement_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Sequential_Statement_Chain (Get_Kind (Target))); - return Get_Field5 (Target); - end Get_Sequential_Statement_Chain; - - procedure Set_Sequential_Statement_Chain (Target : Iir; Chain : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Sequential_Statement_Chain (Get_Kind (Target))); - Set_Field5 (Target, Chain); - end Set_Sequential_Statement_Chain; - - function Get_Subprogram_Body (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Subprogram_Body (Get_Kind (Target))); - return Get_Field9 (Target); - end Get_Subprogram_Body; - - procedure Set_Subprogram_Body (Target : Iir; A_Body : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Subprogram_Body (Get_Kind (Target))); - Set_Field9 (Target, A_Body); - end Set_Subprogram_Body; - - function Get_Overload_Number (Target : Iir) return Iir_Int32 is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Overload_Number (Get_Kind (Target))); - return Iir_Int32'Val (Get_Field12 (Target)); - end Get_Overload_Number; - - procedure Set_Overload_Number (Target : Iir; Val : Iir_Int32) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Overload_Number (Get_Kind (Target))); - Set_Field12 (Target, Iir_Int32'Pos (Val)); - end Set_Overload_Number; - - function Get_Subprogram_Depth (Target : Iir) return Iir_Int32 is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Subprogram_Depth (Get_Kind (Target))); - return Iir_Int32'Val (Get_Field10 (Target)); - end Get_Subprogram_Depth; - - procedure Set_Subprogram_Depth (Target : Iir; Depth : Iir_Int32) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Subprogram_Depth (Get_Kind (Target))); - Set_Field10 (Target, Iir_Int32'Pos (Depth)); - end Set_Subprogram_Depth; - - function Get_Subprogram_Hash (Target : Iir) return Iir_Int32 is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Subprogram_Hash (Get_Kind (Target))); - return Iir_Int32'Val (Get_Field11 (Target)); - end Get_Subprogram_Hash; - - procedure Set_Subprogram_Hash (Target : Iir; Val : Iir_Int32) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Subprogram_Hash (Get_Kind (Target))); - Set_Field11 (Target, Iir_Int32'Pos (Val)); - end Set_Subprogram_Hash; - - function Get_Impure_Depth (Target : Iir) return Iir_Int32 is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Impure_Depth (Get_Kind (Target))); - return Iir_To_Iir_Int32 (Get_Field3 (Target)); - end Get_Impure_Depth; - - procedure Set_Impure_Depth (Target : Iir; Depth : Iir_Int32) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Impure_Depth (Get_Kind (Target))); - Set_Field3 (Target, Iir_Int32_To_Iir (Depth)); - end Set_Impure_Depth; - - function Get_Return_Type (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Return_Type (Get_Kind (Target))); - return Get_Field1 (Target); - end Get_Return_Type; - - procedure Set_Return_Type (Target : Iir; Decl : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Return_Type (Get_Kind (Target))); - Set_Field1 (Target, Decl); - end Set_Return_Type; - - function Get_Implicit_Definition (D : Iir) return Iir_Predefined_Functions - is - begin - pragma Assert (D /= Null_Iir); - pragma Assert (Has_Implicit_Definition (Get_Kind (D))); - return Iir_Predefined_Functions'Val (Get_Field9 (D)); - end Get_Implicit_Definition; - - procedure Set_Implicit_Definition (D : Iir; Def : Iir_Predefined_Functions) - is - begin - pragma Assert (D /= Null_Iir); - pragma Assert (Has_Implicit_Definition (Get_Kind (D))); - Set_Field9 (D, Iir_Predefined_Functions'Pos (Def)); - end Set_Implicit_Definition; - - function Get_Type_Reference (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Type_Reference (Get_Kind (Target))); - return Get_Field10 (Target); - end Get_Type_Reference; - - procedure Set_Type_Reference (Target : Iir; Decl : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Type_Reference (Get_Kind (Target))); - Set_Field10 (Target, Decl); - end Set_Type_Reference; - - function Get_Default_Value (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Default_Value (Get_Kind (Target))); - return Get_Field6 (Target); - end Get_Default_Value; - - procedure Set_Default_Value (Target : Iir; Value : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Default_Value (Get_Kind (Target))); - Set_Field6 (Target, Value); - end Set_Default_Value; - - function Get_Deferred_Declaration (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Deferred_Declaration (Get_Kind (Target))); - return Get_Field7 (Target); - end Get_Deferred_Declaration; - - procedure Set_Deferred_Declaration (Target : Iir; Decl : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Deferred_Declaration (Get_Kind (Target))); - Set_Field7 (Target, Decl); - end Set_Deferred_Declaration; - - function Get_Deferred_Declaration_Flag (Target : Iir) return Boolean is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Deferred_Declaration_Flag (Get_Kind (Target))); - return Get_Flag1 (Target); - end Get_Deferred_Declaration_Flag; - - procedure Set_Deferred_Declaration_Flag (Target : Iir; Flag : Boolean) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Deferred_Declaration_Flag (Get_Kind (Target))); - Set_Flag1 (Target, Flag); - end Set_Deferred_Declaration_Flag; - - function Get_Shared_Flag (Target : Iir) return Boolean is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Shared_Flag (Get_Kind (Target))); - return Get_Flag2 (Target); - end Get_Shared_Flag; - - procedure Set_Shared_Flag (Target : Iir; Shared : Boolean) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Shared_Flag (Get_Kind (Target))); - Set_Flag2 (Target, Shared); - end Set_Shared_Flag; - - function Get_Design_Unit (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Design_Unit (Get_Kind (Target))); - return Get_Field0 (Target); - end Get_Design_Unit; - - procedure Set_Design_Unit (Target : Iir; Unit : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Design_Unit (Get_Kind (Target))); - Set_Field0 (Target, Unit); - end Set_Design_Unit; - - function Get_Block_Statement (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Block_Statement (Get_Kind (Target))); - return Get_Field7 (Target); - end Get_Block_Statement; - - procedure Set_Block_Statement (Target : Iir; Block : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Block_Statement (Get_Kind (Target))); - Set_Field7 (Target, Block); - end Set_Block_Statement; - - function Get_Signal_Driver (Target : Iir_Signal_Declaration) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Signal_Driver (Get_Kind (Target))); - return Get_Field7 (Target); - end Get_Signal_Driver; - - procedure Set_Signal_Driver (Target : Iir_Signal_Declaration; Driver : Iir) - is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Signal_Driver (Get_Kind (Target))); - Set_Field7 (Target, Driver); - end Set_Signal_Driver; - - function Get_Declaration_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Declaration_Chain (Get_Kind (Target))); - return Get_Field1 (Target); - end Get_Declaration_Chain; - - procedure Set_Declaration_Chain (Target : Iir; Decls : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Declaration_Chain (Get_Kind (Target))); - Set_Field1 (Target, Decls); - end Set_Declaration_Chain; - - function Get_File_Logical_Name (Target : Iir_File_Declaration) return Iir - is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_File_Logical_Name (Get_Kind (Target))); - return Get_Field6 (Target); - end Get_File_Logical_Name; - - procedure Set_File_Logical_Name (Target : Iir_File_Declaration; Name : Iir) - is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_File_Logical_Name (Get_Kind (Target))); - Set_Field6 (Target, Name); - end Set_File_Logical_Name; - - function Get_File_Open_Kind (Target : Iir_File_Declaration) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_File_Open_Kind (Get_Kind (Target))); - return Get_Field7 (Target); - end Get_File_Open_Kind; - - procedure Set_File_Open_Kind (Target : Iir_File_Declaration; Kind : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_File_Open_Kind (Get_Kind (Target))); - Set_Field7 (Target, Kind); - end Set_File_Open_Kind; - - function Get_Element_Position (Target : Iir) return Iir_Index32 is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Element_Position (Get_Kind (Target))); - return Iir_Index32'Val (Get_Field4 (Target)); - end Get_Element_Position; - - procedure Set_Element_Position (Target : Iir; Pos : Iir_Index32) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Element_Position (Get_Kind (Target))); - Set_Field4 (Target, Iir_Index32'Pos (Pos)); - end Set_Element_Position; - - function Get_Element_Declaration (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Element_Declaration (Get_Kind (Target))); - return Get_Field2 (Target); - end Get_Element_Declaration; - - procedure Set_Element_Declaration (Target : Iir; El : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Element_Declaration (Get_Kind (Target))); - Set_Field2 (Target, El); - end Set_Element_Declaration; - - function Get_Selected_Element (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Selected_Element (Get_Kind (Target))); - return Get_Field2 (Target); - end Get_Selected_Element; - - procedure Set_Selected_Element (Target : Iir; El : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Selected_Element (Get_Kind (Target))); - Set_Field2 (Target, El); - end Set_Selected_Element; - - function Get_Use_Clause_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Use_Clause_Chain (Get_Kind (Target))); - return Get_Field3 (Target); - end Get_Use_Clause_Chain; - - procedure Set_Use_Clause_Chain (Target : Iir; Chain : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Use_Clause_Chain (Get_Kind (Target))); - Set_Field3 (Target, Chain); - end Set_Use_Clause_Chain; - - function Get_Selected_Name (Target : Iir_Use_Clause) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Selected_Name (Get_Kind (Target))); - return Get_Field1 (Target); - end Get_Selected_Name; - - procedure Set_Selected_Name (Target : Iir_Use_Clause; Name : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Selected_Name (Get_Kind (Target))); - Set_Field1 (Target, Name); - end Set_Selected_Name; - - function Get_Type_Declarator (Def : Iir) return Iir is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Type_Declarator (Get_Kind (Def))); - return Get_Field3 (Def); - end Get_Type_Declarator; - - procedure Set_Type_Declarator (Def : Iir; Decl : Iir) is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Type_Declarator (Get_Kind (Def))); - Set_Field3 (Def, Decl); - end Set_Type_Declarator; - - function Get_Enumeration_Literal_List (Target : Iir) return Iir_List is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Enumeration_Literal_List (Get_Kind (Target))); - return Iir_To_Iir_List (Get_Field2 (Target)); - end Get_Enumeration_Literal_List; - - procedure Set_Enumeration_Literal_List (Target : Iir; List : Iir_List) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Enumeration_Literal_List (Get_Kind (Target))); - Set_Field2 (Target, Iir_List_To_Iir (List)); - end Set_Enumeration_Literal_List; - - function Get_Entity_Class_Entry_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Entity_Class_Entry_Chain (Get_Kind (Target))); - return Get_Field1 (Target); - end Get_Entity_Class_Entry_Chain; - - procedure Set_Entity_Class_Entry_Chain (Target : Iir; Chain : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Entity_Class_Entry_Chain (Get_Kind (Target))); - Set_Field1 (Target, Chain); - end Set_Entity_Class_Entry_Chain; - - function Get_Group_Constituent_List (Group : Iir) return Iir_List is - begin - pragma Assert (Group /= Null_Iir); - pragma Assert (Has_Group_Constituent_List (Get_Kind (Group))); - return Iir_To_Iir_List (Get_Field1 (Group)); - end Get_Group_Constituent_List; - - procedure Set_Group_Constituent_List (Group : Iir; List : Iir_List) is - begin - pragma Assert (Group /= Null_Iir); - pragma Assert (Has_Group_Constituent_List (Get_Kind (Group))); - Set_Field1 (Group, Iir_List_To_Iir (List)); - end Set_Group_Constituent_List; - - function Get_Unit_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Unit_Chain (Get_Kind (Target))); - return Get_Field1 (Target); - end Get_Unit_Chain; - - procedure Set_Unit_Chain (Target : Iir; Chain : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Unit_Chain (Get_Kind (Target))); - Set_Field1 (Target, Chain); - end Set_Unit_Chain; - - function Get_Primary_Unit (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Primary_Unit (Get_Kind (Target))); - return Get_Field1 (Target); - end Get_Primary_Unit; - - procedure Set_Primary_Unit (Target : Iir; Unit : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Primary_Unit (Get_Kind (Target))); - Set_Field1 (Target, Unit); - end Set_Primary_Unit; - - function Get_Identifier (Target : Iir) return Name_Id is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Identifier (Get_Kind (Target))); - return Iir_To_Name_Id (Get_Field3 (Target)); - end Get_Identifier; - - procedure Set_Identifier (Target : Iir; Identifier : Name_Id) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Identifier (Get_Kind (Target))); - Set_Field3 (Target, Name_Id_To_Iir (Identifier)); - end Set_Identifier; - - function Get_Label (Target : Iir) return Name_Id is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Label (Get_Kind (Target))); - return Iir_To_Name_Id (Get_Field3 (Target)); - end Get_Label; - - procedure Set_Label (Target : Iir; Label : Name_Id) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Label (Get_Kind (Target))); - Set_Field3 (Target, Name_Id_To_Iir (Label)); - end Set_Label; - - function Get_Visible_Flag (Target : Iir) return Boolean is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Visible_Flag (Get_Kind (Target))); - return Get_Flag4 (Target); - end Get_Visible_Flag; - - procedure Set_Visible_Flag (Target : Iir; Flag : Boolean) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Visible_Flag (Get_Kind (Target))); - Set_Flag4 (Target, Flag); - end Set_Visible_Flag; - - function Get_Range_Constraint (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Range_Constraint (Get_Kind (Target))); - return Get_Field1 (Target); - end Get_Range_Constraint; - - procedure Set_Range_Constraint (Target : Iir; Constraint : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Range_Constraint (Get_Kind (Target))); - Set_Field1 (Target, Constraint); - end Set_Range_Constraint; - - function Get_Direction (Decl : Iir) return Iir_Direction is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Direction (Get_Kind (Decl))); - return Iir_Direction'Val (Get_State2 (Decl)); - end Get_Direction; - - procedure Set_Direction (Decl : Iir; Dir : Iir_Direction) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Direction (Get_Kind (Decl))); - Set_State2 (Decl, Iir_Direction'Pos (Dir)); - end Set_Direction; - - function Get_Left_Limit (Decl : Iir_Range_Expression) return Iir is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Left_Limit (Get_Kind (Decl))); - return Get_Field2 (Decl); - end Get_Left_Limit; - - procedure Set_Left_Limit (Decl : Iir_Range_Expression; Limit : Iir) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Left_Limit (Get_Kind (Decl))); - Set_Field2 (Decl, Limit); - end Set_Left_Limit; - - function Get_Right_Limit (Decl : Iir_Range_Expression) return Iir is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Right_Limit (Get_Kind (Decl))); - return Get_Field3 (Decl); - end Get_Right_Limit; - - procedure Set_Right_Limit (Decl : Iir_Range_Expression; Limit : Iir) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Right_Limit (Get_Kind (Decl))); - Set_Field3 (Decl, Limit); - end Set_Right_Limit; - - function Get_Base_Type (Decl : Iir) return Iir is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Base_Type (Get_Kind (Decl))); - return Get_Field4 (Decl); - end Get_Base_Type; - - procedure Set_Base_Type (Decl : Iir; Base_Type : Iir) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Base_Type (Get_Kind (Decl))); - Set_Field4 (Decl, Base_Type); - end Set_Base_Type; - - function Get_Resolution_Indication (Decl : Iir) return Iir is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Resolution_Indication (Get_Kind (Decl))); - return Get_Field5 (Decl); - end Get_Resolution_Indication; - - procedure Set_Resolution_Indication (Decl : Iir; Ind : Iir) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Resolution_Indication (Get_Kind (Decl))); - Set_Field5 (Decl, Ind); - end Set_Resolution_Indication; - - function Get_Record_Element_Resolution_Chain (Res : Iir) return Iir is - begin - pragma Assert (Res /= Null_Iir); - pragma Assert (Has_Record_Element_Resolution_Chain (Get_Kind (Res))); - return Get_Field1 (Res); - end Get_Record_Element_Resolution_Chain; - - procedure Set_Record_Element_Resolution_Chain (Res : Iir; Chain : Iir) is - begin - pragma Assert (Res /= Null_Iir); - pragma Assert (Has_Record_Element_Resolution_Chain (Get_Kind (Res))); - Set_Field1 (Res, Chain); - end Set_Record_Element_Resolution_Chain; - - function Get_Tolerance (Def : Iir) return Iir is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Tolerance (Get_Kind (Def))); - return Get_Field7 (Def); - end Get_Tolerance; - - procedure Set_Tolerance (Def : Iir; Tol : Iir) is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Tolerance (Get_Kind (Def))); - Set_Field7 (Def, Tol); - end Set_Tolerance; - - function Get_Plus_Terminal (Def : Iir) return Iir is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Plus_Terminal (Get_Kind (Def))); - return Get_Field8 (Def); - end Get_Plus_Terminal; - - procedure Set_Plus_Terminal (Def : Iir; Terminal : Iir) is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Plus_Terminal (Get_Kind (Def))); - Set_Field8 (Def, Terminal); - end Set_Plus_Terminal; - - function Get_Minus_Terminal (Def : Iir) return Iir is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Minus_Terminal (Get_Kind (Def))); - return Get_Field9 (Def); - end Get_Minus_Terminal; - - procedure Set_Minus_Terminal (Def : Iir; Terminal : Iir) is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Minus_Terminal (Get_Kind (Def))); - Set_Field9 (Def, Terminal); - end Set_Minus_Terminal; - - function Get_Simultaneous_Left (Def : Iir) return Iir is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Simultaneous_Left (Get_Kind (Def))); - return Get_Field5 (Def); - end Get_Simultaneous_Left; - - procedure Set_Simultaneous_Left (Def : Iir; Expr : Iir) is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Simultaneous_Left (Get_Kind (Def))); - Set_Field5 (Def, Expr); - end Set_Simultaneous_Left; - - function Get_Simultaneous_Right (Def : Iir) return Iir is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Simultaneous_Right (Get_Kind (Def))); - return Get_Field6 (Def); - end Get_Simultaneous_Right; - - procedure Set_Simultaneous_Right (Def : Iir; Expr : Iir) is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Simultaneous_Right (Get_Kind (Def))); - Set_Field6 (Def, Expr); - end Set_Simultaneous_Right; - - function Get_Text_File_Flag (Atype : Iir) return Boolean is - begin - pragma Assert (Atype /= Null_Iir); - pragma Assert (Has_Text_File_Flag (Get_Kind (Atype))); - return Get_Flag4 (Atype); - end Get_Text_File_Flag; - - procedure Set_Text_File_Flag (Atype : Iir; Flag : Boolean) is - begin - pragma Assert (Atype /= Null_Iir); - pragma Assert (Has_Text_File_Flag (Get_Kind (Atype))); - Set_Flag4 (Atype, Flag); - end Set_Text_File_Flag; - - function Get_Only_Characters_Flag (Atype : Iir) return Boolean is - begin - pragma Assert (Atype /= Null_Iir); - pragma Assert (Has_Only_Characters_Flag (Get_Kind (Atype))); - return Get_Flag4 (Atype); - end Get_Only_Characters_Flag; - - procedure Set_Only_Characters_Flag (Atype : Iir; Flag : Boolean) is - begin - pragma Assert (Atype /= Null_Iir); - pragma Assert (Has_Only_Characters_Flag (Get_Kind (Atype))); - Set_Flag4 (Atype, Flag); - end Set_Only_Characters_Flag; - - function Get_Type_Staticness (Atype : Iir) return Iir_Staticness is - begin - pragma Assert (Atype /= Null_Iir); - pragma Assert (Has_Type_Staticness (Get_Kind (Atype))); - return Iir_Staticness'Val (Get_State1 (Atype)); - end Get_Type_Staticness; - - procedure Set_Type_Staticness (Atype : Iir; Static : Iir_Staticness) is - begin - pragma Assert (Atype /= Null_Iir); - pragma Assert (Has_Type_Staticness (Get_Kind (Atype))); - Set_State1 (Atype, Iir_Staticness'Pos (Static)); - end Set_Type_Staticness; - - function Get_Constraint_State (Atype : Iir) return Iir_Constraint is - begin - pragma Assert (Atype /= Null_Iir); - pragma Assert (Has_Constraint_State (Get_Kind (Atype))); - return Iir_Constraint'Val (Get_State2 (Atype)); - end Get_Constraint_State; - - procedure Set_Constraint_State (Atype : Iir; State : Iir_Constraint) is - begin - pragma Assert (Atype /= Null_Iir); - pragma Assert (Has_Constraint_State (Get_Kind (Atype))); - Set_State2 (Atype, Iir_Constraint'Pos (State)); - end Set_Constraint_State; - - function Get_Index_Subtype_List (Decl : Iir) return Iir_List is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Index_Subtype_List (Get_Kind (Decl))); - return Iir_To_Iir_List (Get_Field9 (Decl)); - end Get_Index_Subtype_List; - - procedure Set_Index_Subtype_List (Decl : Iir; List : Iir_List) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Index_Subtype_List (Get_Kind (Decl))); - Set_Field9 (Decl, Iir_List_To_Iir (List)); - end Set_Index_Subtype_List; - - function Get_Index_Subtype_Definition_List (Def : Iir) return Iir_List is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Index_Subtype_Definition_List (Get_Kind (Def))); - return Iir_To_Iir_List (Get_Field6 (Def)); - end Get_Index_Subtype_Definition_List; - - procedure Set_Index_Subtype_Definition_List (Def : Iir; Idx : Iir_List) is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Index_Subtype_Definition_List (Get_Kind (Def))); - Set_Field6 (Def, Iir_List_To_Iir (Idx)); - end Set_Index_Subtype_Definition_List; - - function Get_Element_Subtype_Indication (Decl : Iir) return Iir is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Element_Subtype_Indication (Get_Kind (Decl))); - return Get_Field2 (Decl); - end Get_Element_Subtype_Indication; - - procedure Set_Element_Subtype_Indication (Decl : Iir; Sub_Type : Iir) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Element_Subtype_Indication (Get_Kind (Decl))); - Set_Field2 (Decl, Sub_Type); - end Set_Element_Subtype_Indication; - - function Get_Element_Subtype (Decl : Iir) return Iir is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Element_Subtype (Get_Kind (Decl))); - return Get_Field1 (Decl); - end Get_Element_Subtype; - - procedure Set_Element_Subtype (Decl : Iir; Sub_Type : Iir) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Element_Subtype (Get_Kind (Decl))); - Set_Field1 (Decl, Sub_Type); - end Set_Element_Subtype; - - function Get_Index_Constraint_List (Def : Iir) return Iir_List is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Index_Constraint_List (Get_Kind (Def))); - return Iir_To_Iir_List (Get_Field6 (Def)); - end Get_Index_Constraint_List; - - procedure Set_Index_Constraint_List (Def : Iir; List : Iir_List) is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Index_Constraint_List (Get_Kind (Def))); - Set_Field6 (Def, Iir_List_To_Iir (List)); - end Set_Index_Constraint_List; - - function Get_Array_Element_Constraint (Def : Iir) return Iir is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Array_Element_Constraint (Get_Kind (Def))); - return Get_Field8 (Def); - end Get_Array_Element_Constraint; - - procedure Set_Array_Element_Constraint (Def : Iir; El : Iir) is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Array_Element_Constraint (Get_Kind (Def))); - Set_Field8 (Def, El); - end Set_Array_Element_Constraint; - - function Get_Elements_Declaration_List (Decl : Iir) return Iir_List is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Elements_Declaration_List (Get_Kind (Decl))); - return Iir_To_Iir_List (Get_Field1 (Decl)); - end Get_Elements_Declaration_List; - - procedure Set_Elements_Declaration_List (Decl : Iir; List : Iir_List) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Elements_Declaration_List (Get_Kind (Decl))); - Set_Field1 (Decl, Iir_List_To_Iir (List)); - end Set_Elements_Declaration_List; - - function Get_Designated_Type (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Designated_Type (Get_Kind (Target))); - return Get_Field1 (Target); - end Get_Designated_Type; - - procedure Set_Designated_Type (Target : Iir; Dtype : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Designated_Type (Get_Kind (Target))); - Set_Field1 (Target, Dtype); - end Set_Designated_Type; - - function Get_Designated_Subtype_Indication (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Designated_Subtype_Indication (Get_Kind (Target))); - return Get_Field5 (Target); - end Get_Designated_Subtype_Indication; - - procedure Set_Designated_Subtype_Indication (Target : Iir; Dtype : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Designated_Subtype_Indication (Get_Kind (Target))); - Set_Field5 (Target, Dtype); - end Set_Designated_Subtype_Indication; - - function Get_Index_List (Decl : Iir) return Iir_List is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Index_List (Get_Kind (Decl))); - return Iir_To_Iir_List (Get_Field2 (Decl)); - end Get_Index_List; - - procedure Set_Index_List (Decl : Iir; List : Iir_List) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Index_List (Get_Kind (Decl))); - Set_Field2 (Decl, Iir_List_To_Iir (List)); - end Set_Index_List; - - function Get_Reference (Def : Iir) return Iir is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Reference (Get_Kind (Def))); - return Get_Field2 (Def); - end Get_Reference; - - procedure Set_Reference (Def : Iir; Ref : Iir) is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Reference (Get_Kind (Def))); - Set_Field2 (Def, Ref); - end Set_Reference; - - function Get_Nature_Declarator (Def : Iir) return Iir is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Nature_Declarator (Get_Kind (Def))); - return Get_Field3 (Def); - end Get_Nature_Declarator; - - procedure Set_Nature_Declarator (Def : Iir; Decl : Iir) is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Nature_Declarator (Get_Kind (Def))); - Set_Field3 (Def, Decl); - end Set_Nature_Declarator; - - function Get_Across_Type (Def : Iir) return Iir is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Across_Type (Get_Kind (Def))); - return Get_Field7 (Def); - end Get_Across_Type; - - procedure Set_Across_Type (Def : Iir; Atype : Iir) is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Across_Type (Get_Kind (Def))); - Set_Field7 (Def, Atype); - end Set_Across_Type; - - function Get_Through_Type (Def : Iir) return Iir is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Through_Type (Get_Kind (Def))); - return Get_Field8 (Def); - end Get_Through_Type; - - procedure Set_Through_Type (Def : Iir; Atype : Iir) is - begin - pragma Assert (Def /= Null_Iir); - pragma Assert (Has_Through_Type (Get_Kind (Def))); - Set_Field8 (Def, Atype); - end Set_Through_Type; - - function Get_Target (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Target (Get_Kind (Target))); - return Get_Field1 (Target); - end Get_Target; - - procedure Set_Target (Target : Iir; Atarget : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Target (Get_Kind (Target))); - Set_Field1 (Target, Atarget); - end Set_Target; - - function Get_Waveform_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Waveform_Chain (Get_Kind (Target))); - return Get_Field5 (Target); - end Get_Waveform_Chain; - - procedure Set_Waveform_Chain (Target : Iir; Chain : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Waveform_Chain (Get_Kind (Target))); - Set_Field5 (Target, Chain); - end Set_Waveform_Chain; - - function Get_Guard (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Guard (Get_Kind (Target))); - return Get_Field8 (Target); - end Get_Guard; - - procedure Set_Guard (Target : Iir; Guard : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Guard (Get_Kind (Target))); - Set_Field8 (Target, Guard); - end Set_Guard; - - function Get_Delay_Mechanism (Target : Iir) return Iir_Delay_Mechanism is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Delay_Mechanism (Get_Kind (Target))); - return Iir_Delay_Mechanism'Val (Get_Field12 (Target)); - end Get_Delay_Mechanism; - - procedure Set_Delay_Mechanism (Target : Iir; Kind : Iir_Delay_Mechanism) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Delay_Mechanism (Get_Kind (Target))); - Set_Field12 (Target, Iir_Delay_Mechanism'Pos (Kind)); - end Set_Delay_Mechanism; - - function Get_Reject_Time_Expression (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Reject_Time_Expression (Get_Kind (Target))); - return Get_Field6 (Target); - end Get_Reject_Time_Expression; - - procedure Set_Reject_Time_Expression (Target : Iir; Expr : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Reject_Time_Expression (Get_Kind (Target))); - Set_Field6 (Target, Expr); - end Set_Reject_Time_Expression; - - function Get_Sensitivity_List (Wait : Iir) return Iir_List is - begin - pragma Assert (Wait /= Null_Iir); - pragma Assert (Has_Sensitivity_List (Get_Kind (Wait))); - return Iir_To_Iir_List (Get_Field6 (Wait)); - end Get_Sensitivity_List; - - procedure Set_Sensitivity_List (Wait : Iir; List : Iir_List) is - begin - pragma Assert (Wait /= Null_Iir); - pragma Assert (Has_Sensitivity_List (Get_Kind (Wait))); - Set_Field6 (Wait, Iir_List_To_Iir (List)); - end Set_Sensitivity_List; - - function Get_Process_Origin (Proc : Iir) return Iir is - begin - pragma Assert (Proc /= Null_Iir); - pragma Assert (Has_Process_Origin (Get_Kind (Proc))); - return Get_Field8 (Proc); - end Get_Process_Origin; - - procedure Set_Process_Origin (Proc : Iir; Orig : Iir) is - begin - pragma Assert (Proc /= Null_Iir); - pragma Assert (Has_Process_Origin (Get_Kind (Proc))); - Set_Field8 (Proc, Orig); - end Set_Process_Origin; - - function Get_Condition_Clause (Wait : Iir_Wait_Statement) return Iir is - begin - pragma Assert (Wait /= Null_Iir); - pragma Assert (Has_Condition_Clause (Get_Kind (Wait))); - return Get_Field5 (Wait); - end Get_Condition_Clause; - - procedure Set_Condition_Clause (Wait : Iir_Wait_Statement; Cond : Iir) is - begin - pragma Assert (Wait /= Null_Iir); - pragma Assert (Has_Condition_Clause (Get_Kind (Wait))); - Set_Field5 (Wait, Cond); - end Set_Condition_Clause; - - function Get_Timeout_Clause (Wait : Iir_Wait_Statement) return Iir is - begin - pragma Assert (Wait /= Null_Iir); - pragma Assert (Has_Timeout_Clause (Get_Kind (Wait))); - return Get_Field1 (Wait); - end Get_Timeout_Clause; - - procedure Set_Timeout_Clause (Wait : Iir_Wait_Statement; Timeout : Iir) is - begin - pragma Assert (Wait /= Null_Iir); - pragma Assert (Has_Timeout_Clause (Get_Kind (Wait))); - Set_Field1 (Wait, Timeout); - end Set_Timeout_Clause; - - function Get_Postponed_Flag (Target : Iir) return Boolean is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Postponed_Flag (Get_Kind (Target))); - return Get_Flag3 (Target); - end Get_Postponed_Flag; - - procedure Set_Postponed_Flag (Target : Iir; Value : Boolean) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Postponed_Flag (Get_Kind (Target))); - Set_Flag3 (Target, Value); - end Set_Postponed_Flag; - - function Get_Callees_List (Proc : Iir) return Iir_List is - begin - pragma Assert (Proc /= Null_Iir); - pragma Assert (Has_Callees_List (Get_Kind (Proc))); - return Iir_To_Iir_List (Get_Field7 (Proc)); - end Get_Callees_List; - - procedure Set_Callees_List (Proc : Iir; List : Iir_List) is - begin - pragma Assert (Proc /= Null_Iir); - pragma Assert (Has_Callees_List (Get_Kind (Proc))); - Set_Field7 (Proc, Iir_List_To_Iir (List)); - end Set_Callees_List; - - function Get_Passive_Flag (Proc : Iir) return Boolean is - begin - pragma Assert (Proc /= Null_Iir); - pragma Assert (Has_Passive_Flag (Get_Kind (Proc))); - return Get_Flag2 (Proc); - end Get_Passive_Flag; - - procedure Set_Passive_Flag (Proc : Iir; Flag : Boolean) is - begin - pragma Assert (Proc /= Null_Iir); - pragma Assert (Has_Passive_Flag (Get_Kind (Proc))); - Set_Flag2 (Proc, Flag); - end Set_Passive_Flag; - - function Get_Resolution_Function_Flag (Func : Iir) return Boolean is - begin - pragma Assert (Func /= Null_Iir); - pragma Assert (Has_Resolution_Function_Flag (Get_Kind (Func))); - return Get_Flag7 (Func); - end Get_Resolution_Function_Flag; - - procedure Set_Resolution_Function_Flag (Func : Iir; Flag : Boolean) is - begin - pragma Assert (Func /= Null_Iir); - pragma Assert (Has_Resolution_Function_Flag (Get_Kind (Func))); - Set_Flag7 (Func, Flag); - end Set_Resolution_Function_Flag; - - function Get_Wait_State (Proc : Iir) return Tri_State_Type is - begin - pragma Assert (Proc /= Null_Iir); - pragma Assert (Has_Wait_State (Get_Kind (Proc))); - return Tri_State_Type'Val (Get_State1 (Proc)); - end Get_Wait_State; - - procedure Set_Wait_State (Proc : Iir; State : Tri_State_Type) is - begin - pragma Assert (Proc /= Null_Iir); - pragma Assert (Has_Wait_State (Get_Kind (Proc))); - Set_State1 (Proc, Tri_State_Type'Pos (State)); - end Set_Wait_State; - - function Get_All_Sensitized_State (Proc : Iir) return Iir_All_Sensitized is - begin - pragma Assert (Proc /= Null_Iir); - pragma Assert (Has_All_Sensitized_State (Get_Kind (Proc))); - return Iir_All_Sensitized'Val (Get_State3 (Proc)); - end Get_All_Sensitized_State; - - procedure Set_All_Sensitized_State (Proc : Iir; State : Iir_All_Sensitized) - is - begin - pragma Assert (Proc /= Null_Iir); - pragma Assert (Has_All_Sensitized_State (Get_Kind (Proc))); - Set_State3 (Proc, Iir_All_Sensitized'Pos (State)); - end Set_All_Sensitized_State; - - function Get_Seen_Flag (Proc : Iir) return Boolean is - begin - pragma Assert (Proc /= Null_Iir); - pragma Assert (Has_Seen_Flag (Get_Kind (Proc))); - return Get_Flag1 (Proc); - end Get_Seen_Flag; - - procedure Set_Seen_Flag (Proc : Iir; Flag : Boolean) is - begin - pragma Assert (Proc /= Null_Iir); - pragma Assert (Has_Seen_Flag (Get_Kind (Proc))); - Set_Flag1 (Proc, Flag); - end Set_Seen_Flag; - - function Get_Pure_Flag (Func : Iir) return Boolean is - begin - pragma Assert (Func /= Null_Iir); - pragma Assert (Has_Pure_Flag (Get_Kind (Func))); - return Get_Flag2 (Func); - end Get_Pure_Flag; - - procedure Set_Pure_Flag (Func : Iir; Flag : Boolean) is - begin - pragma Assert (Func /= Null_Iir); - pragma Assert (Has_Pure_Flag (Get_Kind (Func))); - Set_Flag2 (Func, Flag); - end Set_Pure_Flag; - - function Get_Foreign_Flag (Decl : Iir) return Boolean is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Foreign_Flag (Get_Kind (Decl))); - return Get_Flag3 (Decl); - end Get_Foreign_Flag; - - procedure Set_Foreign_Flag (Decl : Iir; Flag : Boolean) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Foreign_Flag (Get_Kind (Decl))); - Set_Flag3 (Decl, Flag); - end Set_Foreign_Flag; - - function Get_Resolved_Flag (Atype : Iir) return Boolean is - begin - pragma Assert (Atype /= Null_Iir); - pragma Assert (Has_Resolved_Flag (Get_Kind (Atype))); - return Get_Flag1 (Atype); - end Get_Resolved_Flag; - - procedure Set_Resolved_Flag (Atype : Iir; Flag : Boolean) is - begin - pragma Assert (Atype /= Null_Iir); - pragma Assert (Has_Resolved_Flag (Get_Kind (Atype))); - Set_Flag1 (Atype, Flag); - end Set_Resolved_Flag; - - function Get_Signal_Type_Flag (Atype : Iir) return Boolean is - begin - pragma Assert (Atype /= Null_Iir); - pragma Assert (Has_Signal_Type_Flag (Get_Kind (Atype))); - return Get_Flag2 (Atype); - end Get_Signal_Type_Flag; - - procedure Set_Signal_Type_Flag (Atype : Iir; Flag : Boolean) is - begin - pragma Assert (Atype /= Null_Iir); - pragma Assert (Has_Signal_Type_Flag (Get_Kind (Atype))); - Set_Flag2 (Atype, Flag); - end Set_Signal_Type_Flag; - - function Get_Has_Signal_Flag (Atype : Iir) return Boolean is - begin - pragma Assert (Atype /= Null_Iir); - pragma Assert (Has_Has_Signal_Flag (Get_Kind (Atype))); - return Get_Flag3 (Atype); - end Get_Has_Signal_Flag; - - procedure Set_Has_Signal_Flag (Atype : Iir; Flag : Boolean) is - begin - pragma Assert (Atype /= Null_Iir); - pragma Assert (Has_Has_Signal_Flag (Get_Kind (Atype))); - Set_Flag3 (Atype, Flag); - end Set_Has_Signal_Flag; - - function Get_Purity_State (Proc : Iir) return Iir_Pure_State is - begin - pragma Assert (Proc /= Null_Iir); - pragma Assert (Has_Purity_State (Get_Kind (Proc))); - return Iir_Pure_State'Val (Get_State2 (Proc)); - end Get_Purity_State; - - procedure Set_Purity_State (Proc : Iir; State : Iir_Pure_State) is - begin - pragma Assert (Proc /= Null_Iir); - pragma Assert (Has_Purity_State (Get_Kind (Proc))); - Set_State2 (Proc, Iir_Pure_State'Pos (State)); - end Set_Purity_State; - - function Get_Elab_Flag (Design : Iir) return Boolean is - begin - pragma Assert (Design /= Null_Iir); - pragma Assert (Has_Elab_Flag (Get_Kind (Design))); - return Get_Flag3 (Design); - end Get_Elab_Flag; - - procedure Set_Elab_Flag (Design : Iir; Flag : Boolean) is - begin - pragma Assert (Design /= Null_Iir); - pragma Assert (Has_Elab_Flag (Get_Kind (Design))); - Set_Flag3 (Design, Flag); - end Set_Elab_Flag; - - function Get_Index_Constraint_Flag (Atype : Iir) return Boolean is - begin - pragma Assert (Atype /= Null_Iir); - pragma Assert (Has_Index_Constraint_Flag (Get_Kind (Atype))); - return Get_Flag4 (Atype); - end Get_Index_Constraint_Flag; - - procedure Set_Index_Constraint_Flag (Atype : Iir; Flag : Boolean) is - begin - pragma Assert (Atype /= Null_Iir); - pragma Assert (Has_Index_Constraint_Flag (Get_Kind (Atype))); - Set_Flag4 (Atype, Flag); - end Set_Index_Constraint_Flag; - - function Get_Assertion_Condition (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Assertion_Condition (Get_Kind (Target))); - return Get_Field1 (Target); - end Get_Assertion_Condition; - - procedure Set_Assertion_Condition (Target : Iir; Cond : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Assertion_Condition (Get_Kind (Target))); - Set_Field1 (Target, Cond); - end Set_Assertion_Condition; - - function Get_Report_Expression (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Report_Expression (Get_Kind (Target))); - return Get_Field6 (Target); - end Get_Report_Expression; - - procedure Set_Report_Expression (Target : Iir; Expr : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Report_Expression (Get_Kind (Target))); - Set_Field6 (Target, Expr); - end Set_Report_Expression; - - function Get_Severity_Expression (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Severity_Expression (Get_Kind (Target))); - return Get_Field5 (Target); - end Get_Severity_Expression; - - procedure Set_Severity_Expression (Target : Iir; Expr : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Severity_Expression (Get_Kind (Target))); - Set_Field5 (Target, Expr); - end Set_Severity_Expression; - - function Get_Instantiated_Unit (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Instantiated_Unit (Get_Kind (Target))); - return Get_Field1 (Target); - end Get_Instantiated_Unit; - - procedure Set_Instantiated_Unit (Target : Iir; Unit : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Instantiated_Unit (Get_Kind (Target))); - Set_Field1 (Target, Unit); - end Set_Instantiated_Unit; - - function Get_Generic_Map_Aspect_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Generic_Map_Aspect_Chain (Get_Kind (Target))); - return Get_Field8 (Target); - end Get_Generic_Map_Aspect_Chain; - - procedure Set_Generic_Map_Aspect_Chain (Target : Iir; Generics : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Generic_Map_Aspect_Chain (Get_Kind (Target))); - Set_Field8 (Target, Generics); - end Set_Generic_Map_Aspect_Chain; - - function Get_Port_Map_Aspect_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Port_Map_Aspect_Chain (Get_Kind (Target))); - return Get_Field9 (Target); - end Get_Port_Map_Aspect_Chain; - - procedure Set_Port_Map_Aspect_Chain (Target : Iir; Port : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Port_Map_Aspect_Chain (Get_Kind (Target))); - Set_Field9 (Target, Port); - end Set_Port_Map_Aspect_Chain; - - function Get_Configuration_Name (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Configuration_Name (Get_Kind (Target))); - return Get_Field1 (Target); - end Get_Configuration_Name; - - procedure Set_Configuration_Name (Target : Iir; Conf : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Configuration_Name (Get_Kind (Target))); - Set_Field1 (Target, Conf); - end Set_Configuration_Name; - - function Get_Component_Configuration (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Component_Configuration (Get_Kind (Target))); - return Get_Field6 (Target); - end Get_Component_Configuration; - - procedure Set_Component_Configuration (Target : Iir; Conf : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Component_Configuration (Get_Kind (Target))); - Set_Field6 (Target, Conf); - end Set_Component_Configuration; - - function Get_Configuration_Specification (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Configuration_Specification (Get_Kind (Target))); - return Get_Field7 (Target); - end Get_Configuration_Specification; - - procedure Set_Configuration_Specification (Target : Iir; Conf : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Configuration_Specification (Get_Kind (Target))); - Set_Field7 (Target, Conf); - end Set_Configuration_Specification; - - function Get_Default_Binding_Indication (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Default_Binding_Indication (Get_Kind (Target))); - return Get_Field5 (Target); - end Get_Default_Binding_Indication; - - procedure Set_Default_Binding_Indication (Target : Iir; Conf : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Default_Binding_Indication (Get_Kind (Target))); - Set_Field5 (Target, Conf); - end Set_Default_Binding_Indication; - - function Get_Default_Configuration_Declaration (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert - (Has_Default_Configuration_Declaration (Get_Kind (Target))); - return Get_Field6 (Target); - end Get_Default_Configuration_Declaration; - - procedure Set_Default_Configuration_Declaration (Target : Iir; Conf : Iir) - is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert - (Has_Default_Configuration_Declaration (Get_Kind (Target))); - Set_Field6 (Target, Conf); - end Set_Default_Configuration_Declaration; - - function Get_Expression (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Expression (Get_Kind (Target))); - return Get_Field5 (Target); - end Get_Expression; - - procedure Set_Expression (Target : Iir; Expr : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Expression (Get_Kind (Target))); - Set_Field5 (Target, Expr); - end Set_Expression; - - function Get_Allocator_Designated_Type (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Allocator_Designated_Type (Get_Kind (Target))); - return Get_Field2 (Target); - end Get_Allocator_Designated_Type; - - procedure Set_Allocator_Designated_Type (Target : Iir; A_Type : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Allocator_Designated_Type (Get_Kind (Target))); - Set_Field2 (Target, A_Type); - end Set_Allocator_Designated_Type; - - function Get_Selected_Waveform_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Selected_Waveform_Chain (Get_Kind (Target))); - return Get_Field7 (Target); - end Get_Selected_Waveform_Chain; - - procedure Set_Selected_Waveform_Chain (Target : Iir; Chain : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Selected_Waveform_Chain (Get_Kind (Target))); - Set_Field7 (Target, Chain); - end Set_Selected_Waveform_Chain; - - function Get_Conditional_Waveform_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Conditional_Waveform_Chain (Get_Kind (Target))); - return Get_Field7 (Target); - end Get_Conditional_Waveform_Chain; - - procedure Set_Conditional_Waveform_Chain (Target : Iir; Chain : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Conditional_Waveform_Chain (Get_Kind (Target))); - Set_Field7 (Target, Chain); - end Set_Conditional_Waveform_Chain; - - function Get_Guard_Expression (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Guard_Expression (Get_Kind (Target))); - return Get_Field2 (Target); - end Get_Guard_Expression; - - procedure Set_Guard_Expression (Target : Iir; Expr : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Guard_Expression (Get_Kind (Target))); - Set_Field2 (Target, Expr); - end Set_Guard_Expression; - - function Get_Guard_Decl (Target : Iir_Block_Statement) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Guard_Decl (Get_Kind (Target))); - return Get_Field8 (Target); - end Get_Guard_Decl; - - procedure Set_Guard_Decl (Target : Iir_Block_Statement; Decl : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Guard_Decl (Get_Kind (Target))); - Set_Field8 (Target, Decl); - end Set_Guard_Decl; - - function Get_Guard_Sensitivity_List (Guard : Iir) return Iir_List is - begin - pragma Assert (Guard /= Null_Iir); - pragma Assert (Has_Guard_Sensitivity_List (Get_Kind (Guard))); - return Iir_To_Iir_List (Get_Field6 (Guard)); - end Get_Guard_Sensitivity_List; - - procedure Set_Guard_Sensitivity_List (Guard : Iir; List : Iir_List) is - begin - pragma Assert (Guard /= Null_Iir); - pragma Assert (Has_Guard_Sensitivity_List (Get_Kind (Guard))); - Set_Field6 (Guard, Iir_List_To_Iir (List)); - end Set_Guard_Sensitivity_List; - - function Get_Block_Block_Configuration (Block : Iir) return Iir is - begin - pragma Assert (Block /= Null_Iir); - pragma Assert (Has_Block_Block_Configuration (Get_Kind (Block))); - return Get_Field6 (Block); - end Get_Block_Block_Configuration; - - procedure Set_Block_Block_Configuration (Block : Iir; Conf : Iir) is - begin - pragma Assert (Block /= Null_Iir); - pragma Assert (Has_Block_Block_Configuration (Get_Kind (Block))); - Set_Field6 (Block, Conf); - end Set_Block_Block_Configuration; - - function Get_Package_Header (Pkg : Iir) return Iir is - begin - pragma Assert (Pkg /= Null_Iir); - pragma Assert (Has_Package_Header (Get_Kind (Pkg))); - return Get_Field5 (Pkg); - end Get_Package_Header; - - procedure Set_Package_Header (Pkg : Iir; Header : Iir) is - begin - pragma Assert (Pkg /= Null_Iir); - pragma Assert (Has_Package_Header (Get_Kind (Pkg))); - Set_Field5 (Pkg, Header); - end Set_Package_Header; - - function Get_Block_Header (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Block_Header (Get_Kind (Target))); - return Get_Field7 (Target); - end Get_Block_Header; - - procedure Set_Block_Header (Target : Iir; Header : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Block_Header (Get_Kind (Target))); - Set_Field7 (Target, Header); - end Set_Block_Header; - - function Get_Uninstantiated_Package_Name (Inst : Iir) return Iir is - begin - pragma Assert (Inst /= Null_Iir); - pragma Assert (Has_Uninstantiated_Package_Name (Get_Kind (Inst))); - return Get_Field5 (Inst); - end Get_Uninstantiated_Package_Name; - - procedure Set_Uninstantiated_Package_Name (Inst : Iir; Name : Iir) is - begin - pragma Assert (Inst /= Null_Iir); - pragma Assert (Has_Uninstantiated_Package_Name (Get_Kind (Inst))); - Set_Field5 (Inst, Name); - end Set_Uninstantiated_Package_Name; - - function Get_Generate_Block_Configuration (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Generate_Block_Configuration (Get_Kind (Target))); - return Get_Field7 (Target); - end Get_Generate_Block_Configuration; - - procedure Set_Generate_Block_Configuration (Target : Iir; Conf : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Generate_Block_Configuration (Get_Kind (Target))); - Set_Field7 (Target, Conf); - end Set_Generate_Block_Configuration; - - function Get_Generation_Scheme (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Generation_Scheme (Get_Kind (Target))); - return Get_Field6 (Target); - end Get_Generation_Scheme; - - procedure Set_Generation_Scheme (Target : Iir; Scheme : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Generation_Scheme (Get_Kind (Target))); - Set_Field6 (Target, Scheme); - end Set_Generation_Scheme; - - function Get_Condition (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Condition (Get_Kind (Target))); - return Get_Field1 (Target); - end Get_Condition; - - procedure Set_Condition (Target : Iir; Condition : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Condition (Get_Kind (Target))); - Set_Field1 (Target, Condition); - end Set_Condition; - - function Get_Else_Clause (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Else_Clause (Get_Kind (Target))); - return Get_Field6 (Target); - end Get_Else_Clause; - - procedure Set_Else_Clause (Target : Iir; Clause : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Else_Clause (Get_Kind (Target))); - Set_Field6 (Target, Clause); - end Set_Else_Clause; - - function Get_Parameter_Specification (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Parameter_Specification (Get_Kind (Target))); - return Get_Field1 (Target); - end Get_Parameter_Specification; - - procedure Set_Parameter_Specification (Target : Iir; Param : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Parameter_Specification (Get_Kind (Target))); - Set_Field1 (Target, Param); - end Set_Parameter_Specification; - - function Get_Parent (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Parent (Get_Kind (Target))); - return Get_Field0 (Target); - end Get_Parent; - - procedure Set_Parent (Target : Iir; Parent : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Parent (Get_Kind (Target))); - Set_Field0 (Target, Parent); - end Set_Parent; - - function Get_Loop_Label (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Loop_Label (Get_Kind (Target))); - return Get_Field5 (Target); - end Get_Loop_Label; - - procedure Set_Loop_Label (Target : Iir; Stmt : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Loop_Label (Get_Kind (Target))); - Set_Field5 (Target, Stmt); - end Set_Loop_Label; - - function Get_Component_Name (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Component_Name (Get_Kind (Target))); - return Get_Field4 (Target); - end Get_Component_Name; - - procedure Set_Component_Name (Target : Iir; Name : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Component_Name (Get_Kind (Target))); - Set_Field4 (Target, Name); - end Set_Component_Name; - - function Get_Instantiation_List (Target : Iir) return Iir_List is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Instantiation_List (Get_Kind (Target))); - return Iir_To_Iir_List (Get_Field1 (Target)); - end Get_Instantiation_List; - - procedure Set_Instantiation_List (Target : Iir; List : Iir_List) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Instantiation_List (Get_Kind (Target))); - Set_Field1 (Target, Iir_List_To_Iir (List)); - end Set_Instantiation_List; - - function Get_Entity_Aspect (Target : Iir_Binding_Indication) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Entity_Aspect (Get_Kind (Target))); - return Get_Field3 (Target); - end Get_Entity_Aspect; - - procedure Set_Entity_Aspect (Target : Iir_Binding_Indication; Entity : Iir) - is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Entity_Aspect (Get_Kind (Target))); - Set_Field3 (Target, Entity); - end Set_Entity_Aspect; - - function Get_Default_Entity_Aspect (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Default_Entity_Aspect (Get_Kind (Target))); - return Get_Field1 (Target); - end Get_Default_Entity_Aspect; - - procedure Set_Default_Entity_Aspect (Target : Iir; Aspect : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Default_Entity_Aspect (Get_Kind (Target))); - Set_Field1 (Target, Aspect); - end Set_Default_Entity_Aspect; - - function Get_Default_Generic_Map_Aspect_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Default_Generic_Map_Aspect_Chain (Get_Kind (Target))); - return Get_Field6 (Target); - end Get_Default_Generic_Map_Aspect_Chain; - - procedure Set_Default_Generic_Map_Aspect_Chain (Target : Iir; Chain : Iir) - is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Default_Generic_Map_Aspect_Chain (Get_Kind (Target))); - Set_Field6 (Target, Chain); - end Set_Default_Generic_Map_Aspect_Chain; - - function Get_Default_Port_Map_Aspect_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Default_Port_Map_Aspect_Chain (Get_Kind (Target))); - return Get_Field7 (Target); - end Get_Default_Port_Map_Aspect_Chain; - - procedure Set_Default_Port_Map_Aspect_Chain (Target : Iir; Chain : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Default_Port_Map_Aspect_Chain (Get_Kind (Target))); - Set_Field7 (Target, Chain); - end Set_Default_Port_Map_Aspect_Chain; - - function Get_Binding_Indication (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Binding_Indication (Get_Kind (Target))); - return Get_Field3 (Target); - end Get_Binding_Indication; - - procedure Set_Binding_Indication (Target : Iir; Binding : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Binding_Indication (Get_Kind (Target))); - Set_Field3 (Target, Binding); - end Set_Binding_Indication; - - function Get_Named_Entity (Name : Iir) return Iir is - begin - pragma Assert (Name /= Null_Iir); - pragma Assert (Has_Named_Entity (Get_Kind (Name))); - return Get_Field4 (Name); - end Get_Named_Entity; - - procedure Set_Named_Entity (Name : Iir; Val : Iir) is - begin - pragma Assert (Name /= Null_Iir); - pragma Assert (Has_Named_Entity (Get_Kind (Name))); - Set_Field4 (Name, Val); - end Set_Named_Entity; - - function Get_Alias_Declaration (Name : Iir) return Iir is - begin - pragma Assert (Name /= Null_Iir); - pragma Assert (Has_Alias_Declaration (Get_Kind (Name))); - return Get_Field2 (Name); - end Get_Alias_Declaration; - - procedure Set_Alias_Declaration (Name : Iir; Val : Iir) is - begin - pragma Assert (Name /= Null_Iir); - pragma Assert (Has_Alias_Declaration (Get_Kind (Name))); - Set_Field2 (Name, Val); - end Set_Alias_Declaration; - - function Get_Expr_Staticness (Target : Iir) return Iir_Staticness is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Expr_Staticness (Get_Kind (Target))); - return Iir_Staticness'Val (Get_State1 (Target)); - end Get_Expr_Staticness; - - procedure Set_Expr_Staticness (Target : Iir; Static : Iir_Staticness) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Expr_Staticness (Get_Kind (Target))); - Set_State1 (Target, Iir_Staticness'Pos (Static)); - end Set_Expr_Staticness; - - function Get_Error_Origin (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Error_Origin (Get_Kind (Target))); - return Get_Field2 (Target); - end Get_Error_Origin; - - procedure Set_Error_Origin (Target : Iir; Origin : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Error_Origin (Get_Kind (Target))); - Set_Field2 (Target, Origin); - end Set_Error_Origin; - - function Get_Operand (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Operand (Get_Kind (Target))); - return Get_Field2 (Target); - end Get_Operand; - - procedure Set_Operand (Target : Iir; An_Iir : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Operand (Get_Kind (Target))); - Set_Field2 (Target, An_Iir); - end Set_Operand; - - function Get_Left (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Left (Get_Kind (Target))); - return Get_Field2 (Target); - end Get_Left; - - procedure Set_Left (Target : Iir; An_Iir : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Left (Get_Kind (Target))); - Set_Field2 (Target, An_Iir); - end Set_Left; - - function Get_Right (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Right (Get_Kind (Target))); - return Get_Field4 (Target); - end Get_Right; - - procedure Set_Right (Target : Iir; An_Iir : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Right (Get_Kind (Target))); - Set_Field4 (Target, An_Iir); - end Set_Right; - - function Get_Unit_Name (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Unit_Name (Get_Kind (Target))); - return Get_Field3 (Target); - end Get_Unit_Name; - - procedure Set_Unit_Name (Target : Iir; Name : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Unit_Name (Get_Kind (Target))); - Set_Field3 (Target, Name); - end Set_Unit_Name; - - function Get_Name (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Name (Get_Kind (Target))); - return Get_Field4 (Target); - end Get_Name; - - procedure Set_Name (Target : Iir; Name : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Name (Get_Kind (Target))); - Set_Field4 (Target, Name); - end Set_Name; - - function Get_Group_Template_Name (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Group_Template_Name (Get_Kind (Target))); - return Get_Field5 (Target); - end Get_Group_Template_Name; - - procedure Set_Group_Template_Name (Target : Iir; Name : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Group_Template_Name (Get_Kind (Target))); - Set_Field5 (Target, Name); - end Set_Group_Template_Name; - - function Get_Name_Staticness (Target : Iir) return Iir_Staticness is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Name_Staticness (Get_Kind (Target))); - return Iir_Staticness'Val (Get_State2 (Target)); - end Get_Name_Staticness; - - procedure Set_Name_Staticness (Target : Iir; Static : Iir_Staticness) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Name_Staticness (Get_Kind (Target))); - Set_State2 (Target, Iir_Staticness'Pos (Static)); - end Set_Name_Staticness; - - function Get_Prefix (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Prefix (Get_Kind (Target))); - return Get_Field0 (Target); - end Get_Prefix; - - procedure Set_Prefix (Target : Iir; Prefix : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Prefix (Get_Kind (Target))); - Set_Field0 (Target, Prefix); - end Set_Prefix; - - function Get_Signature_Prefix (Sign : Iir) return Iir is - begin - pragma Assert (Sign /= Null_Iir); - pragma Assert (Has_Signature_Prefix (Get_Kind (Sign))); - return Get_Field1 (Sign); - end Get_Signature_Prefix; - - procedure Set_Signature_Prefix (Sign : Iir; Prefix : Iir) is - begin - pragma Assert (Sign /= Null_Iir); - pragma Assert (Has_Signature_Prefix (Get_Kind (Sign))); - Set_Field1 (Sign, Prefix); - end Set_Signature_Prefix; - - function Get_Slice_Subtype (Slice : Iir) return Iir is - begin - pragma Assert (Slice /= Null_Iir); - pragma Assert (Has_Slice_Subtype (Get_Kind (Slice))); - return Get_Field3 (Slice); - end Get_Slice_Subtype; - - procedure Set_Slice_Subtype (Slice : Iir; Atype : Iir) is - begin - pragma Assert (Slice /= Null_Iir); - pragma Assert (Has_Slice_Subtype (Get_Kind (Slice))); - Set_Field3 (Slice, Atype); - end Set_Slice_Subtype; - - function Get_Suffix (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Suffix (Get_Kind (Target))); - return Get_Field2 (Target); - end Get_Suffix; - - procedure Set_Suffix (Target : Iir; Suffix : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Suffix (Get_Kind (Target))); - Set_Field2 (Target, Suffix); - end Set_Suffix; - - function Get_Index_Subtype (Attr : Iir) return Iir is - begin - pragma Assert (Attr /= Null_Iir); - pragma Assert (Has_Index_Subtype (Get_Kind (Attr))); - return Get_Field2 (Attr); - end Get_Index_Subtype; - - procedure Set_Index_Subtype (Attr : Iir; St : Iir) is - begin - pragma Assert (Attr /= Null_Iir); - pragma Assert (Has_Index_Subtype (Get_Kind (Attr))); - Set_Field2 (Attr, St); - end Set_Index_Subtype; - - function Get_Parameter (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Parameter (Get_Kind (Target))); - return Get_Field4 (Target); - end Get_Parameter; - - procedure Set_Parameter (Target : Iir; Param : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Parameter (Get_Kind (Target))); - Set_Field4 (Target, Param); - end Set_Parameter; - - function Get_Actual_Type (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Actual_Type (Get_Kind (Target))); - return Get_Field3 (Target); - end Get_Actual_Type; - - procedure Set_Actual_Type (Target : Iir; Atype : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Actual_Type (Get_Kind (Target))); - Set_Field3 (Target, Atype); - end Set_Actual_Type; - - function Get_Associated_Interface (Assoc : Iir) return Iir is - begin - pragma Assert (Assoc /= Null_Iir); - pragma Assert (Has_Associated_Interface (Get_Kind (Assoc))); - return Get_Field4 (Assoc); - end Get_Associated_Interface; - - procedure Set_Associated_Interface (Assoc : Iir; Inter : Iir) is - begin - pragma Assert (Assoc /= Null_Iir); - pragma Assert (Has_Associated_Interface (Get_Kind (Assoc))); - Set_Field4 (Assoc, Inter); - end Set_Associated_Interface; - - function Get_Association_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Association_Chain (Get_Kind (Target))); - return Get_Field2 (Target); - end Get_Association_Chain; - - procedure Set_Association_Chain (Target : Iir; Chain : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Association_Chain (Get_Kind (Target))); - Set_Field2 (Target, Chain); - end Set_Association_Chain; - - function Get_Individual_Association_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Individual_Association_Chain (Get_Kind (Target))); - return Get_Field4 (Target); - end Get_Individual_Association_Chain; - - procedure Set_Individual_Association_Chain (Target : Iir; Chain : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Individual_Association_Chain (Get_Kind (Target))); - Set_Field4 (Target, Chain); - end Set_Individual_Association_Chain; - - function Get_Aggregate_Info (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Aggregate_Info (Get_Kind (Target))); - return Get_Field2 (Target); - end Get_Aggregate_Info; - - procedure Set_Aggregate_Info (Target : Iir; Info : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Aggregate_Info (Get_Kind (Target))); - Set_Field2 (Target, Info); - end Set_Aggregate_Info; - - function Get_Sub_Aggregate_Info (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Sub_Aggregate_Info (Get_Kind (Target))); - return Get_Field1 (Target); - end Get_Sub_Aggregate_Info; - - procedure Set_Sub_Aggregate_Info (Target : Iir; Info : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Sub_Aggregate_Info (Get_Kind (Target))); - Set_Field1 (Target, Info); - end Set_Sub_Aggregate_Info; - - function Get_Aggr_Dynamic_Flag (Target : Iir) return Boolean is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Aggr_Dynamic_Flag (Get_Kind (Target))); - return Get_Flag3 (Target); - end Get_Aggr_Dynamic_Flag; - - procedure Set_Aggr_Dynamic_Flag (Target : Iir; Val : Boolean) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Aggr_Dynamic_Flag (Get_Kind (Target))); - Set_Flag3 (Target, Val); - end Set_Aggr_Dynamic_Flag; - - function Get_Aggr_Min_Length (Info : Iir_Aggregate_Info) return Iir_Int32 - is - begin - pragma Assert (Info /= Null_Iir); - pragma Assert (Has_Aggr_Min_Length (Get_Kind (Info))); - return Iir_To_Iir_Int32 (Get_Field4 (Info)); - end Get_Aggr_Min_Length; - - procedure Set_Aggr_Min_Length (Info : Iir_Aggregate_Info; Nbr : Iir_Int32) - is - begin - pragma Assert (Info /= Null_Iir); - pragma Assert (Has_Aggr_Min_Length (Get_Kind (Info))); - Set_Field4 (Info, Iir_Int32_To_Iir (Nbr)); - end Set_Aggr_Min_Length; - - function Get_Aggr_Low_Limit (Target : Iir_Aggregate_Info) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Aggr_Low_Limit (Get_Kind (Target))); - return Get_Field2 (Target); - end Get_Aggr_Low_Limit; - - procedure Set_Aggr_Low_Limit (Target : Iir_Aggregate_Info; Limit : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Aggr_Low_Limit (Get_Kind (Target))); - Set_Field2 (Target, Limit); - end Set_Aggr_Low_Limit; - - function Get_Aggr_High_Limit (Target : Iir_Aggregate_Info) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Aggr_High_Limit (Get_Kind (Target))); - return Get_Field3 (Target); - end Get_Aggr_High_Limit; - - procedure Set_Aggr_High_Limit (Target : Iir_Aggregate_Info; Limit : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Aggr_High_Limit (Get_Kind (Target))); - Set_Field3 (Target, Limit); - end Set_Aggr_High_Limit; - - function Get_Aggr_Others_Flag (Target : Iir_Aggregate_Info) return Boolean - is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Aggr_Others_Flag (Get_Kind (Target))); - return Get_Flag2 (Target); - end Get_Aggr_Others_Flag; - - procedure Set_Aggr_Others_Flag (Target : Iir_Aggregate_Info; Val : Boolean) - is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Aggr_Others_Flag (Get_Kind (Target))); - Set_Flag2 (Target, Val); - end Set_Aggr_Others_Flag; - - function Get_Aggr_Named_Flag (Target : Iir_Aggregate_Info) return Boolean - is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Aggr_Named_Flag (Get_Kind (Target))); - return Get_Flag4 (Target); - end Get_Aggr_Named_Flag; - - procedure Set_Aggr_Named_Flag (Target : Iir_Aggregate_Info; Val : Boolean) - is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Aggr_Named_Flag (Get_Kind (Target))); - Set_Flag4 (Target, Val); - end Set_Aggr_Named_Flag; - - function Get_Value_Staticness (Target : Iir) return Iir_Staticness is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Value_Staticness (Get_Kind (Target))); - return Iir_Staticness'Val (Get_State2 (Target)); - end Get_Value_Staticness; - - procedure Set_Value_Staticness (Target : Iir; Staticness : Iir_Staticness) - is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Value_Staticness (Get_Kind (Target))); - Set_State2 (Target, Iir_Staticness'Pos (Staticness)); - end Set_Value_Staticness; - - function Get_Association_Choices_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Association_Choices_Chain (Get_Kind (Target))); - return Get_Field4 (Target); - end Get_Association_Choices_Chain; - - procedure Set_Association_Choices_Chain (Target : Iir; Chain : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Association_Choices_Chain (Get_Kind (Target))); - Set_Field4 (Target, Chain); - end Set_Association_Choices_Chain; - - function Get_Case_Statement_Alternative_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Case_Statement_Alternative_Chain (Get_Kind (Target))); - return Get_Field1 (Target); - end Get_Case_Statement_Alternative_Chain; - - procedure Set_Case_Statement_Alternative_Chain (Target : Iir; Chain : Iir) - is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Case_Statement_Alternative_Chain (Get_Kind (Target))); - Set_Field1 (Target, Chain); - end Set_Case_Statement_Alternative_Chain; - - function Get_Choice_Staticness (Target : Iir) return Iir_Staticness is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Choice_Staticness (Get_Kind (Target))); - return Iir_Staticness'Val (Get_State2 (Target)); - end Get_Choice_Staticness; - - procedure Set_Choice_Staticness (Target : Iir; Staticness : Iir_Staticness) - is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Choice_Staticness (Get_Kind (Target))); - Set_State2 (Target, Iir_Staticness'Pos (Staticness)); - end Set_Choice_Staticness; - - function Get_Procedure_Call (Stmt : Iir) return Iir is - begin - pragma Assert (Stmt /= Null_Iir); - pragma Assert (Has_Procedure_Call (Get_Kind (Stmt))); - return Get_Field1 (Stmt); - end Get_Procedure_Call; - - procedure Set_Procedure_Call (Stmt : Iir; Call : Iir) is - begin - pragma Assert (Stmt /= Null_Iir); - pragma Assert (Has_Procedure_Call (Get_Kind (Stmt))); - Set_Field1 (Stmt, Call); - end Set_Procedure_Call; - - function Get_Implementation (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Implementation (Get_Kind (Target))); - return Get_Field3 (Target); - end Get_Implementation; - - procedure Set_Implementation (Target : Iir; Decl : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Implementation (Get_Kind (Target))); - Set_Field3 (Target, Decl); - end Set_Implementation; - - function Get_Parameter_Association_Chain (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Parameter_Association_Chain (Get_Kind (Target))); - return Get_Field2 (Target); - end Get_Parameter_Association_Chain; - - procedure Set_Parameter_Association_Chain (Target : Iir; Chain : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Parameter_Association_Chain (Get_Kind (Target))); - Set_Field2 (Target, Chain); - end Set_Parameter_Association_Chain; - - function Get_Method_Object (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Method_Object (Get_Kind (Target))); - return Get_Field4 (Target); - end Get_Method_Object; - - procedure Set_Method_Object (Target : Iir; Object : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Method_Object (Get_Kind (Target))); - Set_Field4 (Target, Object); - end Set_Method_Object; - - function Get_Subtype_Type_Mark (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Subtype_Type_Mark (Get_Kind (Target))); - return Get_Field2 (Target); - end Get_Subtype_Type_Mark; - - procedure Set_Subtype_Type_Mark (Target : Iir; Mark : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Subtype_Type_Mark (Get_Kind (Target))); - Set_Field2 (Target, Mark); - end Set_Subtype_Type_Mark; - - function Get_Type_Conversion_Subtype (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Type_Conversion_Subtype (Get_Kind (Target))); - return Get_Field3 (Target); - end Get_Type_Conversion_Subtype; - - procedure Set_Type_Conversion_Subtype (Target : Iir; Atype : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Type_Conversion_Subtype (Get_Kind (Target))); - Set_Field3 (Target, Atype); - end Set_Type_Conversion_Subtype; - - function Get_Type_Mark (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Type_Mark (Get_Kind (Target))); - return Get_Field4 (Target); - end Get_Type_Mark; - - procedure Set_Type_Mark (Target : Iir; Mark : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Type_Mark (Get_Kind (Target))); - Set_Field4 (Target, Mark); - end Set_Type_Mark; - - function Get_File_Type_Mark (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_File_Type_Mark (Get_Kind (Target))); - return Get_Field2 (Target); - end Get_File_Type_Mark; - - procedure Set_File_Type_Mark (Target : Iir; Mark : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_File_Type_Mark (Get_Kind (Target))); - Set_Field2 (Target, Mark); - end Set_File_Type_Mark; - - function Get_Return_Type_Mark (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Return_Type_Mark (Get_Kind (Target))); - return Get_Field8 (Target); - end Get_Return_Type_Mark; - - procedure Set_Return_Type_Mark (Target : Iir; Mark : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Return_Type_Mark (Get_Kind (Target))); - Set_Field8 (Target, Mark); - end Set_Return_Type_Mark; - - function Get_Lexical_Layout (Decl : Iir) return Iir_Lexical_Layout_Type is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Lexical_Layout (Get_Kind (Decl))); - return Iir_Lexical_Layout_Type'Val (Get_Odigit2 (Decl)); - end Get_Lexical_Layout; - - procedure Set_Lexical_Layout (Decl : Iir; Lay : Iir_Lexical_Layout_Type) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Lexical_Layout (Get_Kind (Decl))); - Set_Odigit2 (Decl, Iir_Lexical_Layout_Type'Pos (Lay)); - end Set_Lexical_Layout; - - function Get_Incomplete_Type_List (Target : Iir) return Iir_List is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Incomplete_Type_List (Get_Kind (Target))); - return Iir_To_Iir_List (Get_Field2 (Target)); - end Get_Incomplete_Type_List; - - procedure Set_Incomplete_Type_List (Target : Iir; List : Iir_List) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Incomplete_Type_List (Get_Kind (Target))); - Set_Field2 (Target, Iir_List_To_Iir (List)); - end Set_Incomplete_Type_List; - - function Get_Has_Disconnect_Flag (Target : Iir) return Boolean is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Has_Disconnect_Flag (Get_Kind (Target))); - return Get_Flag1 (Target); - end Get_Has_Disconnect_Flag; - - procedure Set_Has_Disconnect_Flag (Target : Iir; Val : Boolean) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Has_Disconnect_Flag (Get_Kind (Target))); - Set_Flag1 (Target, Val); - end Set_Has_Disconnect_Flag; - - function Get_Has_Active_Flag (Target : Iir) return Boolean is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Has_Active_Flag (Get_Kind (Target))); - return Get_Flag2 (Target); - end Get_Has_Active_Flag; - - procedure Set_Has_Active_Flag (Target : Iir; Val : Boolean) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Has_Active_Flag (Get_Kind (Target))); - Set_Flag2 (Target, Val); - end Set_Has_Active_Flag; - - function Get_Is_Within_Flag (Target : Iir) return Boolean is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Is_Within_Flag (Get_Kind (Target))); - return Get_Flag5 (Target); - end Get_Is_Within_Flag; - - procedure Set_Is_Within_Flag (Target : Iir; Val : Boolean) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Is_Within_Flag (Get_Kind (Target))); - Set_Flag5 (Target, Val); - end Set_Is_Within_Flag; - - function Get_Type_Marks_List (Target : Iir) return Iir_List is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Type_Marks_List (Get_Kind (Target))); - return Iir_To_Iir_List (Get_Field2 (Target)); - end Get_Type_Marks_List; - - procedure Set_Type_Marks_List (Target : Iir; List : Iir_List) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Type_Marks_List (Get_Kind (Target))); - Set_Field2 (Target, Iir_List_To_Iir (List)); - end Set_Type_Marks_List; - - function Get_Implicit_Alias_Flag (Decl : Iir) return Boolean is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Implicit_Alias_Flag (Get_Kind (Decl))); - return Get_Flag1 (Decl); - end Get_Implicit_Alias_Flag; - - procedure Set_Implicit_Alias_Flag (Decl : Iir; Flag : Boolean) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Implicit_Alias_Flag (Get_Kind (Decl))); - Set_Flag1 (Decl, Flag); - end Set_Implicit_Alias_Flag; - - function Get_Alias_Signature (Alias : Iir) return Iir is - begin - pragma Assert (Alias /= Null_Iir); - pragma Assert (Has_Alias_Signature (Get_Kind (Alias))); - return Get_Field5 (Alias); - end Get_Alias_Signature; - - procedure Set_Alias_Signature (Alias : Iir; Signature : Iir) is - begin - pragma Assert (Alias /= Null_Iir); - pragma Assert (Has_Alias_Signature (Get_Kind (Alias))); - Set_Field5 (Alias, Signature); - end Set_Alias_Signature; - - function Get_Attribute_Signature (Attr : Iir) return Iir is - begin - pragma Assert (Attr /= Null_Iir); - pragma Assert (Has_Attribute_Signature (Get_Kind (Attr))); - return Get_Field2 (Attr); - end Get_Attribute_Signature; - - procedure Set_Attribute_Signature (Attr : Iir; Signature : Iir) is - begin - pragma Assert (Attr /= Null_Iir); - pragma Assert (Has_Attribute_Signature (Get_Kind (Attr))); - Set_Field2 (Attr, Signature); - end Set_Attribute_Signature; - - function Get_Overload_List (Target : Iir) return Iir_List is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Overload_List (Get_Kind (Target))); - return Iir_To_Iir_List (Get_Field1 (Target)); - end Get_Overload_List; - - procedure Set_Overload_List (Target : Iir; List : Iir_List) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Overload_List (Get_Kind (Target))); - Set_Field1 (Target, Iir_List_To_Iir (List)); - end Set_Overload_List; - - function Get_Simple_Name_Identifier (Target : Iir) return Name_Id is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Simple_Name_Identifier (Get_Kind (Target))); - return Iir_To_Name_Id (Get_Field3 (Target)); - end Get_Simple_Name_Identifier; - - procedure Set_Simple_Name_Identifier (Target : Iir; Ident : Name_Id) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Simple_Name_Identifier (Get_Kind (Target))); - Set_Field3 (Target, Name_Id_To_Iir (Ident)); - end Set_Simple_Name_Identifier; - - function Get_Simple_Name_Subtype (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Simple_Name_Subtype (Get_Kind (Target))); - return Get_Field4 (Target); - end Get_Simple_Name_Subtype; - - procedure Set_Simple_Name_Subtype (Target : Iir; Atype : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Simple_Name_Subtype (Get_Kind (Target))); - Set_Field4 (Target, Atype); - end Set_Simple_Name_Subtype; - - function Get_Protected_Type_Body (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Protected_Type_Body (Get_Kind (Target))); - return Get_Field2 (Target); - end Get_Protected_Type_Body; - - procedure Set_Protected_Type_Body (Target : Iir; Bod : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Protected_Type_Body (Get_Kind (Target))); - Set_Field2 (Target, Bod); - end Set_Protected_Type_Body; - - function Get_Protected_Type_Declaration (Target : Iir) return Iir is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Protected_Type_Declaration (Get_Kind (Target))); - return Get_Field4 (Target); - end Get_Protected_Type_Declaration; - - procedure Set_Protected_Type_Declaration (Target : Iir; Decl : Iir) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Protected_Type_Declaration (Get_Kind (Target))); - Set_Field4 (Target, Decl); - end Set_Protected_Type_Declaration; - - function Get_End_Location (Target : Iir) return Location_Type is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_End_Location (Get_Kind (Target))); - return Iir_To_Location_Type (Get_Field6 (Target)); - end Get_End_Location; - - procedure Set_End_Location (Target : Iir; Loc : Location_Type) is - begin - pragma Assert (Target /= Null_Iir); - pragma Assert (Has_End_Location (Get_Kind (Target))); - Set_Field6 (Target, Location_Type_To_Iir (Loc)); - end Set_End_Location; - - function Get_String_Id (Lit : Iir) return String_Id is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_String_Id (Get_Kind (Lit))); - return Iir_To_String_Id (Get_Field3 (Lit)); - end Get_String_Id; - - procedure Set_String_Id (Lit : Iir; Id : String_Id) is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_String_Id (Get_Kind (Lit))); - Set_Field3 (Lit, String_Id_To_Iir (Id)); - end Set_String_Id; - - function Get_String_Length (Lit : Iir) return Int32 is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_String_Length (Get_Kind (Lit))); - return Iir_To_Int32 (Get_Field4 (Lit)); - end Get_String_Length; - - procedure Set_String_Length (Lit : Iir; Len : Int32) is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_String_Length (Get_Kind (Lit))); - Set_Field4 (Lit, Int32_To_Iir (Len)); - end Set_String_Length; - - function Get_Use_Flag (Decl : Iir) return Boolean is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Use_Flag (Get_Kind (Decl))); - return Get_Flag6 (Decl); - end Get_Use_Flag; - - procedure Set_Use_Flag (Decl : Iir; Val : Boolean) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Use_Flag (Get_Kind (Decl))); - Set_Flag6 (Decl, Val); - end Set_Use_Flag; - - function Get_End_Has_Reserved_Id (Decl : Iir) return Boolean is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_End_Has_Reserved_Id (Get_Kind (Decl))); - return Get_Flag8 (Decl); - end Get_End_Has_Reserved_Id; - - procedure Set_End_Has_Reserved_Id (Decl : Iir; Flag : Boolean) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_End_Has_Reserved_Id (Get_Kind (Decl))); - Set_Flag8 (Decl, Flag); - end Set_End_Has_Reserved_Id; - - function Get_End_Has_Identifier (Decl : Iir) return Boolean is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_End_Has_Identifier (Get_Kind (Decl))); - return Get_Flag9 (Decl); - end Get_End_Has_Identifier; - - procedure Set_End_Has_Identifier (Decl : Iir; Flag : Boolean) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_End_Has_Identifier (Get_Kind (Decl))); - Set_Flag9 (Decl, Flag); - end Set_End_Has_Identifier; - - function Get_End_Has_Postponed (Decl : Iir) return Boolean is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_End_Has_Postponed (Get_Kind (Decl))); - return Get_Flag10 (Decl); - end Get_End_Has_Postponed; - - procedure Set_End_Has_Postponed (Decl : Iir; Flag : Boolean) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_End_Has_Postponed (Get_Kind (Decl))); - Set_Flag10 (Decl, Flag); - end Set_End_Has_Postponed; - - function Get_Has_Begin (Decl : Iir) return Boolean is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Has_Begin (Get_Kind (Decl))); - return Get_Flag10 (Decl); - end Get_Has_Begin; - - procedure Set_Has_Begin (Decl : Iir; Flag : Boolean) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Has_Begin (Get_Kind (Decl))); - Set_Flag10 (Decl, Flag); - end Set_Has_Begin; - - function Get_Has_Is (Decl : Iir) return Boolean is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Has_Is (Get_Kind (Decl))); - return Get_Flag7 (Decl); - end Get_Has_Is; - - procedure Set_Has_Is (Decl : Iir; Flag : Boolean) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Has_Is (Get_Kind (Decl))); - Set_Flag7 (Decl, Flag); - end Set_Has_Is; - - function Get_Has_Pure (Decl : Iir) return Boolean is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Has_Pure (Get_Kind (Decl))); - return Get_Flag8 (Decl); - end Get_Has_Pure; - - procedure Set_Has_Pure (Decl : Iir; Flag : Boolean) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Has_Pure (Get_Kind (Decl))); - Set_Flag8 (Decl, Flag); - end Set_Has_Pure; - - function Get_Has_Body (Decl : Iir) return Boolean is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Has_Body (Get_Kind (Decl))); - return Get_Flag9 (Decl); - end Get_Has_Body; - - procedure Set_Has_Body (Decl : Iir; Flag : Boolean) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Has_Body (Get_Kind (Decl))); - Set_Flag9 (Decl, Flag); - end Set_Has_Body; - - function Get_Has_Identifier_List (Decl : Iir) return Boolean is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Has_Identifier_List (Get_Kind (Decl))); - return Get_Flag3 (Decl); - end Get_Has_Identifier_List; - - procedure Set_Has_Identifier_List (Decl : Iir; Flag : Boolean) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Has_Identifier_List (Get_Kind (Decl))); - Set_Flag3 (Decl, Flag); - end Set_Has_Identifier_List; - - function Get_Has_Mode (Decl : Iir) return Boolean is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Has_Mode (Get_Kind (Decl))); - return Get_Flag8 (Decl); - end Get_Has_Mode; - - procedure Set_Has_Mode (Decl : Iir; Flag : Boolean) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Has_Mode (Get_Kind (Decl))); - Set_Flag8 (Decl, Flag); - end Set_Has_Mode; - - function Get_Is_Ref (N : Iir) return Boolean is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Is_Ref (Get_Kind (N))); - return Get_Flag7 (N); - end Get_Is_Ref; - - procedure Set_Is_Ref (N : Iir; Ref : Boolean) is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Is_Ref (Get_Kind (N))); - Set_Flag7 (N, Ref); - end Set_Is_Ref; - - function Get_Psl_Property (Decl : Iir) return PSL_Node is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Psl_Property (Get_Kind (Decl))); - return Iir_To_PSL_Node (Get_Field1 (Decl)); - end Get_Psl_Property; - - procedure Set_Psl_Property (Decl : Iir; Prop : PSL_Node) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Psl_Property (Get_Kind (Decl))); - Set_Field1 (Decl, PSL_Node_To_Iir (Prop)); - end Set_Psl_Property; - - function Get_Psl_Declaration (Decl : Iir) return PSL_Node is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Psl_Declaration (Get_Kind (Decl))); - return Iir_To_PSL_Node (Get_Field1 (Decl)); - end Get_Psl_Declaration; - - procedure Set_Psl_Declaration (Decl : Iir; Prop : PSL_Node) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Psl_Declaration (Get_Kind (Decl))); - Set_Field1 (Decl, PSL_Node_To_Iir (Prop)); - end Set_Psl_Declaration; - - function Get_Psl_Expression (Decl : Iir) return PSL_Node is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Psl_Expression (Get_Kind (Decl))); - return Iir_To_PSL_Node (Get_Field3 (Decl)); - end Get_Psl_Expression; - - procedure Set_Psl_Expression (Decl : Iir; Prop : PSL_Node) is - begin - pragma Assert (Decl /= Null_Iir); - pragma Assert (Has_Psl_Expression (Get_Kind (Decl))); - Set_Field3 (Decl, PSL_Node_To_Iir (Prop)); - end Set_Psl_Expression; - - function Get_Psl_Boolean (N : Iir) return PSL_Node is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Psl_Boolean (Get_Kind (N))); - return Iir_To_PSL_Node (Get_Field1 (N)); - end Get_Psl_Boolean; - - procedure Set_Psl_Boolean (N : Iir; Bool : PSL_Node) is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_Psl_Boolean (Get_Kind (N))); - Set_Field1 (N, PSL_Node_To_Iir (Bool)); - end Set_Psl_Boolean; - - function Get_PSL_Clock (N : Iir) return PSL_Node is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_PSL_Clock (Get_Kind (N))); - return Iir_To_PSL_Node (Get_Field7 (N)); - end Get_PSL_Clock; - - procedure Set_PSL_Clock (N : Iir; Clock : PSL_Node) is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_PSL_Clock (Get_Kind (N))); - Set_Field7 (N, PSL_Node_To_Iir (Clock)); - end Set_PSL_Clock; - - function Get_PSL_NFA (N : Iir) return PSL_NFA is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_PSL_NFA (Get_Kind (N))); - return Iir_To_PSL_NFA (Get_Field8 (N)); - end Get_PSL_NFA; - - procedure Set_PSL_NFA (N : Iir; Fa : PSL_NFA) is - begin - pragma Assert (N /= Null_Iir); - pragma Assert (Has_PSL_NFA (Get_Kind (N))); - Set_Field8 (N, PSL_NFA_To_Iir (Fa)); - end Set_PSL_NFA; - -end Iirs; diff --git a/iirs.adb.in b/iirs.adb.in deleted file mode 100644 index 04511bb67..000000000 --- a/iirs.adb.in +++ /dev/null @@ -1,229 +0,0 @@ --- Tree node definitions. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Ada.Unchecked_Conversion; -with Ada.Text_IO; -with Nodes; use Nodes; -with Lists; use Lists; -with Nodes_Meta; use Nodes_Meta; - -package body Iirs is - function Is_Null (Node : Iir) return Boolean is - begin - return Node = Null_Iir; - end Is_Null; - - function Is_Null_List (Node : Iir_List) return Boolean is - begin - return Node = Null_Iir_List; - end Is_Null_List; - - --------------------------------------------------- - -- General subprograms that operate on every iir -- - --------------------------------------------------- - - function Get_Format (Kind : Iir_Kind) return Format_Type; - - function Create_Iir (Kind : Iir_Kind) return Iir - is - Res : Iir; - Format : Format_Type; - begin - Format := Get_Format (Kind); - Res := Create_Node (Format); - Set_Nkind (Res, Iir_Kind'Pos (Kind)); - return Res; - end Create_Iir; - - -- Statistics. - procedure Disp_Stats - is - use Ada.Text_IO; - type Num_Array is array (Iir_Kind) of Natural; - Num : Num_Array := (others => 0); - type Format_Array is array (Format_Type) of Natural; - Formats : Format_Array := (others => 0); - Kind : Iir_Kind; - I : Iir; - Last_I : Iir; - Format : Format_Type; - begin - I := Error_Node + 1; - Last_I := Get_Last_Node; - while I < Last_I loop - Kind := Get_Kind (I); - Num (Kind) := Num (Kind) + 1; - Format := Get_Format (Kind); - Formats (Format) := Formats (Format) + 1; - case Format is - when Format_Medium => - I := I + 2; - when Format_Short - | Format_Fp - | Format_Int => - I := I + 1; - end case; - end loop; - - Put_Line ("Stats per iir_kind:"); - for J in Iir_Kind loop - if Num (J) /= 0 then - Put_Line (' ' & Iir_Kind'Image (J) & ':' - & Natural'Image (Num (J))); - end if; - end loop; - Put_Line ("Stats per formats:"); - for J in Format_Type loop - Put_Line (' ' & Format_Type'Image (J) & ':' - & Natural'Image (Formats (J))); - end loop; - end Disp_Stats; - - function Iir_Predefined_Shortcut_P (Func : Iir_Predefined_Functions) - return Boolean is - begin - case Func is - when Iir_Predefined_Bit_And - | Iir_Predefined_Bit_Or - | Iir_Predefined_Bit_Nand - | Iir_Predefined_Bit_Nor - | Iir_Predefined_Boolean_And - | Iir_Predefined_Boolean_Or - | Iir_Predefined_Boolean_Nand - | Iir_Predefined_Boolean_Nor => - return True; - when others => - return False; - end case; - end Iir_Predefined_Shortcut_P; - - function Create_Iir_Error return Iir - is - Res : Iir; - begin - Res := Create_Node (Format_Short); - Set_Nkind (Res, Iir_Kind'Pos (Iir_Kind_Error)); - Set_Base_Type (Res, Res); - return Res; - end Create_Iir_Error; - - procedure Location_Copy (Target: Iir; Src: Iir) is - begin - Set_Location (Target, Get_Location (Src)); - end Location_Copy; - - -- Get kind - function Get_Kind (An_Iir: Iir) return Iir_Kind - is - -- Speed up: avoid to check that nkind is in the bounds of Iir_Kind. - pragma Suppress (Range_Check); - begin - return Iir_Kind'Val (Get_Nkind (An_Iir)); - end Get_Kind; - - function Time_Stamp_Id_To_Iir is new Ada.Unchecked_Conversion - (Source => Time_Stamp_Id, Target => Iir); - - function Iir_To_Time_Stamp_Id is new Ada.Unchecked_Conversion - (Source => Iir, Target => Time_Stamp_Id); - - function Iir_To_Iir_List is new Ada.Unchecked_Conversion - (Source => Iir, Target => Iir_List); - function Iir_List_To_Iir is new Ada.Unchecked_Conversion - (Source => Iir_List, Target => Iir); - - function Iir_To_Token_Type (N : Iir) return Token_Type is - begin - return Token_Type'Val (N); - end Iir_To_Token_Type; - - function Token_Type_To_Iir (T : Token_Type) return Iir is - begin - return Token_Type'Pos (T); - end Token_Type_To_Iir; - --- function Iir_To_Iir_Index32 (N : Iir) return Iir_Index32 is --- begin --- return Iir_Index32 (N); --- end Iir_To_Iir_Index32; - --- function Iir_Index32_To_Iir (V : Iir_Index32) return Iir is --- begin --- return Iir_Index32'Pos (V); --- end Iir_Index32_To_Iir; - - function Iir_To_Name_Id (N : Iir) return Name_Id is - begin - return Iir'Pos (N); - end Iir_To_Name_Id; - pragma Inline (Iir_To_Name_Id); - - function Name_Id_To_Iir (V : Name_Id) return Iir is - begin - return Name_Id'Pos (V); - end Name_Id_To_Iir; - - function Iir_To_Iir_Int32 is new Ada.Unchecked_Conversion - (Source => Iir, Target => Iir_Int32); - - function Iir_Int32_To_Iir is new Ada.Unchecked_Conversion - (Source => Iir_Int32, Target => Iir); - - function Iir_To_Source_Ptr (N : Iir) return Source_Ptr is - begin - return Source_Ptr (N); - end Iir_To_Source_Ptr; - - function Source_Ptr_To_Iir (P : Source_Ptr) return Iir is - begin - return Iir (P); - end Source_Ptr_To_Iir; - - function Iir_To_Location_Type (N : Iir) return Location_Type is - begin - return Location_Type (N); - end Iir_To_Location_Type; - - function Location_Type_To_Iir (L : Location_Type) return Iir is - begin - return Iir (L); - end Location_Type_To_Iir; - - function Iir_To_String_Id is new Ada.Unchecked_Conversion - (Source => Iir, Target => String_Id); - function String_Id_To_Iir is new Ada.Unchecked_Conversion - (Source => String_Id, Target => Iir); - - function Iir_To_Int32 is new Ada.Unchecked_Conversion - (Source => Iir, Target => Int32); - function Int32_To_Iir is new Ada.Unchecked_Conversion - (Source => Int32, Target => Iir); - - function Iir_To_PSL_Node is new Ada.Unchecked_Conversion - (Source => Iir, Target => PSL_Node); - - function PSL_Node_To_Iir is new Ada.Unchecked_Conversion - (Source => PSL_Node, Target => Iir); - - function Iir_To_PSL_NFA is new Ada.Unchecked_Conversion - (Source => Iir, Target => PSL_NFA); - - function PSL_NFA_To_Iir is new Ada.Unchecked_Conversion - (Source => PSL_NFA, Target => Iir); - - -- Subprograms -end Iirs; diff --git a/iirs.ads b/iirs.ads deleted file mode 100644 index cd58daa56..000000000 --- a/iirs.ads +++ /dev/null @@ -1,6445 +0,0 @@ --- Tree node definitions. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Ada.Unchecked_Deallocation; -with Types; use Types; -with Tokens; use Tokens; -with Nodes; -with Lists; - -package Iirs is - -- This package defines the semantic tree and functions to handle it. - -- The tree is roughly based on IIR (Internal Intermediate Representation), - -- [AIRE/CE Advanced Intermediate Representation with Extensibility, - -- Common Environment. http://www.vhdl.org/aire/index.html ] - -- but oriented object features are not used, and sometimes, functions - -- or fields have changed. - - -- Note: this tree is also used during syntaxic analysis, but with - -- a little bit different meanings for the fields. - -- The parser (parse package) build the tree. - -- The semantic pass (sem, sem_expr, sem_name) transforms it into a - -- semantic tree. - - -- Documentation: - -- Only the semantic aspect is to be fully documented. - -- The syntaxic aspect is only used between parse and sem. - - -- Each node of the tree is a record of type iir. The record has only - -- one discriminent, which contains the kind of the node. There is - -- currenlty no variant (but this can change, this is not public). - - -- The root of a semantic tree is a library_declaration. - -- All the library_declarations are kept in a private list, held by - -- package libraries. - -- Exemple of a tree: - -- library_declaration - -- +-- design_file - -- +-- design_unit - -- | +-- entity_declaration - -- +-- design_unit - -- +-- architecture_body - -- ... - - -- Since the tree can represent all the libraries and their contents, it - -- is not always loaded into memory. - -- When a library is loaded, only library_declaration, design_file, - -- design_unit and library_unit nodes are created. When a design_unit is - -- really loaded, the design_unit node is not replaced but modified (ie, - -- access to this node are still valid). - - -- To add a new kind of node: - -- the name should be of the form iir_kind_NAME - -- add iir_kind_NAME in the definition of type iir_kind_type - -- document the node below: grammar, methods. - -- for each methods, add the name if the case statement in the body - -- (this enables the methods) - -- add an entry in disp_tree (debugging) - -- handle this node in Errorout.Disp_Node - - -- Meta-grammar - -- This file is processed by a tool to automatically generate the body, so - -- it must follow a meta-grammar. - -- - -- The low level representation is described in nodes.ads. - -- - -- The literals for the nodes must be declared in this file like this: - -- type Iir_Kind is - -- ( - -- Iir_Kind_AAA, - -- ... - -- Iir_Kind_ZZZ - -- ); - -- The tool doesn't check for uniqness as this is done by the compiler. - -- - -- It is possible to declare ranges of kinds like this: - -- subtype Iir_Kinds_RANGE is Iir_Kind range - -- Iir_Kind_FIRST .. - -- --Iir_Kind_MID - -- Iir_Kind_LAST; - -- Literals Iir_Kind_MID are optionnal (FIXME: make them required ?), but - -- if present all the values between FIRST and LAST must be present. - -- - -- The methods appear after the comment: ' -- General methods.' - -- They have the following format: - -- -- Field: FIELD ATTR (CONV) - -- function Get_NAME (PNAME : PTYPE) return RTYPE; - -- procedure Set_NAME (PNAME : PTYPE; RNAME : RTYPE); - -- 'FIELD' indicate which field of the node is used to store the value. - -- ATTR is optional and if present must be one of: - -- Ref: the field is a reference to an existing node - -- Chain: the field contains a chain of nodes - -- Chain_Next: the field contains the next element of a chain (present - -- only on one field: Set/Get_Chain). - -- ' (CONV)' is present if the type of the value (indicated by RTYPE) is - -- different from the type of the field. CONV can be either 'uc' or 'pos'. - -- 'uc' indicates an unchecked conversion while 'pos' a pos/val conversion. - -- - -- Nodes content is described between ' -- Start of Iir_Kind.' and - -- ' -- End of Iir_Kind.' like this: - -- -- Iir_Kind_NODE1 (FORMAT1) - -- -- Iir_Kind_NODE2 (FORMAT2) - -- -- - -- -- Get/Set_NAME1 (FIELD1) - -- -- - -- -- Get/Set_NAME2 (FIELD2) - -- -- Get/Set_NAME3 (Alias FIELD2) - -- -- - -- -- Only for Iir_Kind_NODE1: - -- -- Get/Set_NAME4 (FIELD3) - -- Severals nodes can be described at once; at least one must be described. - -- Fields FIELD1, FIELD2, FIELD3 must be different, unless 'Alias ' is - -- present. The number of spaces is significant. The 'Only for ' lines - -- are optionnal and there may be severals of them. - - ------------------------------------------------- - -- General methods (can be used on all nodes): -- - ------------------------------------------------- - - -- Create a node of kind KIND. - -- function Create_Iir (Kind: Iir_Kind) return Iir; - -- - -- Deallocate a node. Deallocate fields that where allocated by - -- create_iir. - -- procedure Free_Iir (Target: in out Iir); - -- - -- Get the kind of the iir. - -- See below for the (public) list of kinds. - -- function Get_Kind (An_Iir: Iir) return Iir_Kind; - - -- Get the location of the node: ie the current position in the source - -- file when the node was created. This is a little bit fuzzy. - -- - -- procedure Set_Location (Target: in out Iir; Location: Location_Type); - -- function Get_Location (Target: in out Iir) return Location_Type; - -- - -- Copy a location from a node to another one. - -- procedure Location_Copy (Target: in out Iir; Src: in Iir); - - -- The next line marks the start of the node description. - -- Start of Iir_Kind. - - -------------------------------------------------- - -- A set of methods are associed with a kind. -- - -------------------------------------------------- - - -- Iir_Kind_Design_File (Medium) - -- LRM93 11 - -- design_file ::= design_unit { design_unit } - -- - -- The library containing this design file. - -- Get/Set_Library (Field0) - -- Get/Set_Parent (Alias Field0) - -- - -- Get/Set_File_Dependence_List (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Analysis_Time_Stamp (Field3) - -- - -- Get/Set_File_Time_Stamp (Field4) - -- - -- Get the chain of unit contained in the file. This is a simply linked - -- chain, but the tail is kept to speed-up appending operation. - -- Get/Set_First_Design_Unit (Field5) - -- - -- Get/Set_Last_Design_Unit (Field6) - -- - -- Identifier for the design file file name and dirname. - -- Get/Set_Design_File_Filename (Field12) - -- Get/Set_Design_File_Directory (Field11) - -- - -- Flag used during elaboration. Set when the file was already seen. - -- Get/Set_Elab_Flag (Flag3) - - -- Iir_Kind_Design_Unit (Medium) - -- LRM93 11 - -- design_unit ::= context_clause library_unit - -- - -- The design_file containing this design unit. - -- Get/Set_Design_File (Field0) - -- Get/Set_Parent (Alias Field0) - -- - -- Get the chain of context clause. - -- Get/Set_Context_Items (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set the library unit, which can be an entity, an architecture, - -- a package, a package body or a configuration. - -- Get/Set_Library_Unit (Field5) - -- - -- Get/Set_End_Location (Field6) - -- - -- Collision chain for units. - -- Get/Set_Hash_Chain (Field7) - -- - -- Get the list of design units that must be analysed before this unit. - -- See LRM93 11.4 for the rules defining the order of analysis. - -- Get/Set_Dependence_List (Field8) - -- - -- FIXME: this field can be put in the library_unit, since it is only used - -- when the units have been analyzed. - -- Get/Set_Analysis_Checks_List (Field9) - -- - -- This is a symbolic date, only used as a order of analysis of design - -- units. - -- Get/Set_Date (Field10) - -- - -- Set the line and the offset in the line, only for the library manager. - -- This is valid until the file is really loaded in memory. On loading, - -- location will contain all this informations. - -- Get/Set_Design_Unit_Source_Pos (Field4) - -- - -- Get/Set_Design_Unit_Source_Line (Field11) - -- - -- Get/Set_Design_Unit_Source_Col (Field12) - -- - -- Get/Set the date state, which indicates whether this design unit is in - -- memory or not. - -- Get/Set_Date_State (State1) - -- - -- Flag used during elaboration. Set when the file was already seen. - -- Get/Set_Elab_Flag (Flag3) - - -- Iir_Kind_Library_Clause (Short) - -- - -- LRM08 13.2 Design libraries - -- - -- library_clause ::= LIBRARY logical_name_list ; - -- - -- logical_name_list ::= logical_name { , logical_name } - -- - -- logical_name ::= identifier - -- - -- Note: a library_clause node is created for every logical_name. - -- As a consequence, the scope of the library starts after the logical_name - -- and not after the library_clause. However, since an identifier - -- can only be used as a logical_name, and since the second occurence has - -- no effect, this is correct. - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Library_Declaration (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Has_Identifier_List (Flag3) - - --------------- - -- Literals -- - --------------- - - -- Iir_Kind_String_Literal (Short) - -- Iir_Kind_Bit_String_Literal (Medium) - -- - -- Get/Set_Type (Field1) - -- - -- Used for computed literals. Literal_Origin contains the expression - -- whose value was computed during analysis and replaces the expression. - -- Get/Set_Literal_Origin (Field2) - -- - -- Get/Set_String_Id (Field3) - -- - -- As bit-strings are expanded to '0'/'1' strings, this is the number of - -- characters. - -- Get/Set_String_Length (Field4) - -- - -- Same as Type, but marked as property of that node. - -- Get/Set_Literal_Subtype (Field5) - -- - -- For bit string only: - -- Enumeration literal which correspond to '0' and '1'. - -- This cannot be defined only in the enumeration type definition, due to - -- possible aliases. - -- Only for Iir_Kind_Bit_String_Literal: - -- Get/Set_Bit_String_0 (Field6) - -- Only for Iir_Kind_Bit_String_Literal: - -- Get/Set_Bit_String_1 (Field7) - -- - -- Only for Iir_Kind_Bit_String_Literal: - -- Get/Set_Bit_String_Base (Field8) - -- - -- Get/Set_Expr_Staticness (State1) - - -- Iir_Kind_Integer_Literal (Int) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set the value of the integer. - -- Get/Set_Value (Int64) - -- - -- Get/Set_Literal_Origin (Field2) - -- - -- Get/Set_Expr_Staticness (State1) - - -- Iir_Kind_Floating_Point_Literal (Fp) - -- - -- Get/Set_Type (Field1) - -- - -- The value of the literal. - -- Get/Set_Fp_Value (Fp64) - -- - -- Get/Set_Literal_Origin (Field2) - -- - -- Get/Set_Expr_Staticness (State1) - - -- Iir_Kind_Null_Literal (Short) - -- The null literal, which can be a disconnection or a null access. - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Expr_Staticness (State1) - - -- Iir_Kind_Physical_Int_Literal (Int) - -- Iir_Kind_Physical_Fp_Literal (Fp) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Literal_Origin (Field2) - -- - -- The physical unit of the literal. - -- Get/Set_Unit_Name (Field3) - -- - -- Must be set to locally except for time literal, which is globally. - -- Get/Set_Expr_Staticness (State1) - -- - -- Only for Iir_Kind_Physical_Int_Literal: - -- The multiplicand. - -- Get/Set_Value (Int64) - -- - -- Only for Iir_Kind_Physical_Fp_Literal: - -- The multiplicand. - -- Get/Set_Fp_Value (Fp64) - - -- Iir_Kind_Simple_Aggregate (Short) - -- This node can only be generated by evaluation: it is an unidimentional - -- positional aggregate. - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Literal_Origin (Field2) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- List of elements - -- Get/Set_Simple_Aggregate_List (Field3) - -- - -- Same as Type, but marked as property of that node. - -- Get/Set_Literal_Subtype (Field5) - - -- Iir_Kind_Overflow_Literal (Short) - -- This node can only be generated by evaluation to represent an error: out - -- of range, division by zero... - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Literal_Origin (Field2) - -- - -- Get/Set_Expr_Staticness (State1) - - ------------- - -- Tuples -- - ------------- - - -- Iir_Kind_Association_Element_By_Expression (Short) - -- Iir_Kind_Association_Element_Open (Short) - -- Iir_Kind_Association_Element_By_Individual (Short) - -- Iir_Kind_Association_Element_Package (Short) - -- These are used for association element of an association list with - -- an interface (ie subprogram call, port map, generic map). - -- - -- Get/Set_Formal (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Only for Iir_Kind_Association_Element_By_Expression: - -- Only for Iir_Kind_Association_Element_Package: - -- Get/Set_Actual (Field3) - -- - -- Only for Iir_Kind_Association_Element_By_Individual: - -- Get/Set_Actual_Type (Field3) - -- - -- Only for Iir_Kind_Association_Element_By_Individual: - -- Get/Set_Individual_Association_Chain (Field4) - -- - -- Only for Iir_Kind_Association_Element_Package: - -- Get/Set_Associated_Interface (Field4) - -- - -- A function call or a type conversion for the association. - -- FIXME: should be a name ? - -- Only for Iir_Kind_Association_Element_By_Expression: - -- Get/Set_In_Conversion (Field4) - -- - -- Only for Iir_Kind_Association_Element_By_Expression: - -- Get/Set_Out_Conversion (Field5) - -- - -- Get/Set the whole association flag (true if the formal is associated in - -- whole and not individually, see LRM93 4.3.2.2) - -- Get/Set_Whole_Association_Flag (Flag1) - -- - -- Get/Set_Collapse_Signal_Flag (Flag2) - -- - -- Only for Iir_Kind_Association_Element_Open: - -- Get/Set_Artificial_Flag (Flag3) - - -- Iir_Kind_Waveform_Element (Short) - -- - -- Get/Set_We_Value (Field1) - -- - -- Get/Set_Time (Field3) - -- - -- Get/Set_Chain (Field2) - - -- Iir_Kind_Conditional_Waveform (Short) - -- - -- Get/Set_Condition (Field1) - -- - -- Get/Set_Waveform_Chain (Field5) - -- - -- Get/Set_Chain (Field2) - - -- Iir_Kind_Choice_By_Others (Short) - -- Iir_Kind_Choice_By_None (Short) - -- Iir_Kind_Choice_By_Range (Short) - -- Iir_Kind_Choice_By_Name (Short) - -- Iir_Kind_Choice_By_Expression (Short) - -- (Iir_Kinds_Choice) - -- - -- Get/Set_Parent (Field0) - -- - -- For a list of choices, only the first one is associated, the following - -- associations have the same_alternative_flag set. - -- Get/Set_Chain (Field2) - -- - -- These are elements of an choice chain, which is used for - -- case_statement, concurrent_select_signal_assignment, aggregates. - -- - -- Get/Set what is associated with the choice. There are two different - -- nodes, one for simple association and the other for chain association. - -- This simplifies walkers. But both nodes are never used at the same - -- time. - -- - -- For: - -- * an expression for an aggregate - -- * an individual association - -- Get/Set_Associated_Expr (Field3) - -- - -- For - -- * a waveform_chain for a concurrent_select_signal_assignment, - -- * a sequential statement chain for a case_statement. - -- Get/Set_Associated_Chain (Field4) - -- - -- Only for Iir_Kind_Choice_By_Name: - -- Get/Set_Choice_Name (Field5) - -- - -- Only for Iir_Kind_Choice_By_Expression: - -- Get/Set_Choice_Expression (Field5) - -- - -- Only for Iir_Kind_Choice_By_Range: - -- Get/Set_Choice_Range (Field5) - -- - -- Get/Set_Same_Alternative_Flag (Flag1) - -- - -- Only for Iir_Kind_Choice_By_Range: - -- Only for Iir_Kind_Choice_By_Expression: - -- Get/Set_Choice_Staticness (State2) - - -- Iir_Kind_Entity_Aspect_Entity (Short) - -- - -- Get/Set_Entity_Name (Field2) - -- - -- parse: a simple name. - -- sem: an architecture declaration or NULL_IIR. - -- Get/Set_Architecture (Field3) - - -- Iir_Kind_Entity_Aspect_Open (Short) - - -- Iir_Kind_Entity_Aspect_Configuration (Short) - -- - -- Get/Set_Configuration_Name (Field1) - - -- Iir_Kind_Block_Configuration (Short) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Declaration_Chain (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Configuration_Item_Chain (Field3) - -- - -- Note: for default block configurations of iterative generate statement, - -- the block specification is an indexed_name, whose index_list is others. - -- Get/Set_Block_Specification (Field5) - -- - -- Single linked list of block configuration that apply to the same - -- for scheme generate block. - -- Get/Set_Prev_Block_Configuration (Field4) - - -- Iir_Kind_Binding_Indication (Medium) - -- - -- Get/Set_Default_Entity_Aspect (Field1) - -- - -- The entity aspect. - -- It is a iir_kind_entity_aspect_entity, iir_kind_entity_aspect_open or - -- iir_kind_entity_aspect_configuration. This may be transformed into a - -- declaration by semantic. - -- Get/Set_Entity_Aspect (Field3) - -- - -- Get/Set_Default_Generic_Map_Aspect_Chain (Field6) - -- - -- Get/Set_Default_Port_Map_Aspect_Chain (Field7) - -- - -- Get/Set_Generic_Map_Aspect_Chain (Field8) - -- - -- Get/Set_Port_Map_Aspect_Chain (Field9) - - -- Iir_Kind_Component_Configuration (Short) - -- Iir_Kind_Configuration_Specification (Short) - -- - -- LRM08 7.3 Configuration specification - -- - -- configuration_specification ::= - -- simple_configuration_specification - -- | compound_configuration_specification - -- - -- simple_configuration_specification ::= - -- FOR component_specification binding_indication ; - -- [ END FOR ; ] - -- - -- compound_configuration_specification ::= - -- FOR component_specification binding_indication ; - -- verification_unit_binding_indication ; - -- { verification_unit_binding_indication ; } - -- END FOR ; - -- - -- component_specification ::= - -- instantiation_list : component_name - -- - -- instantiation_list ::= - -- instantiation_label { , instantiation_label } - -- | OTHERS - -- | ALL - -- - -- The declaration containing this type declaration. - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Component_Name (Field4) - -- - -- Must be one of designator_list, designator_by_others or - -- designator_by_all. - -- Get/Set_Instantiation_List (Field1) - -- - -- Only for Iir_Kind_Component_Configuration: - -- Get/Set_Block_Configuration (Field5) - -- - -- Get/Set_Binding_Indication (Field3) - -- - -- Get/Set_Chain (Field2) - - -- Iir_Kind_Disconnection_Specification (Short) - -- - -- LRM08 7.4 Disconnection specification - -- - -- disconnection_specification ::= - -- DISCONNECT guarded_signal_specification AFTER time_expression ; - -- - -- guarded_signal_specification ::= - -- guarded_signal_list : type_mark - -- - -- signal_list ::= - -- signal_name { , signal_name } - -- | OTHERS - -- | ALL - -- - -- The declaration containing this type declaration. - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Signal_List (Field3) - -- - -- Get/Set_Type_Mark (Field4) - -- - -- Get/Set_Expression (Field5) - - -- Iir_Kind_Block_Header (Medium) - -- - -- Get/Set_Generic_Chain (Field6) - -- - -- Get/Set_Port_Chain (Field7) - -- - -- Get/Set_Generic_Map_Aspect_Chain (Field8) - -- - -- Get/Set_Port_Map_Aspect_Chain (Field9) - - -- Iir_Kind_Entity_Class (Short) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Entity_Class (Field3) - - -- Iir_Kind_Attribute_Specification (Medium) - -- - -- LRM08 7.2 Attribute specification - -- - -- attribute_specification ::= - -- ATTRIBUTE attribute_designator OF entity_specification - -- IS expression ; - -- - -- entity_specification ::= entity_name_list : entity_class - -- - -- entity_name_list ::= - -- entity_designator { , entity_designator } - -- | OTHERS - -- | ALL - -- - -- entity_designator ::= entity_tag [ signature ] - -- - -- entity_tag ::= simple_name | character_literal | operator_symbol - -- - -- LRM08 8.6 Attribute names - -- - -- attribute_designator ::= /attribute/_simple_name - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Entity_Name_List (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Entity_Class (Field3) - -- - -- Get/Set_Attribute_Value_Spec_Chain (Field4) - -- - -- Get/Set_Expression (Field5) - -- - -- Always a simple name. - -- Get/Set_Attribute_Designator (Field6) - -- - -- Get/Set_Attribute_Specification_Chain (Field7) - - -- Iir_Kind_Attribute_Value (Short) - -- An attribute value is the element of the chain of attribute of an - -- entity, marking the entity as decorated by the attribute. - -- This node is built only by sem. - -- In fact, the node is member of the chain of attribute of an entity, and - -- of the chain of entity of the attribute specification. - -- This makes elaboration (and more precisely, expression evaluation) - -- easier. - -- - -- Get/Set_Spec_Chain (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Designated_Entity (Field3) - -- - -- Get/Set_Attribute_Specification (Field4) - -- - -- Get/Set_Base_Name (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - -- Iir_Kind_Psl_Expression (Short) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Psl_Expression (Field3) - - -- Iir_Kind_Signature (Medium) - -- - -- LRM08 4.5.3 Signatures - -- - -- signature ::= '[' [ type_mark { , type_mark } ] [ RETURN type_mark ] ']' - -- - -- Get/Set_Signature_Prefix (Field1) - -- - -- Get/Set_Type_Marks_List (Field2) - -- - -- Get/Set_Return_Type_Mark (Field8) - - -- Iir_Kind_Overload_List (Short) - -- - -- Get/Set_Overload_List (Field1) - - ------------------- - -- Declarations -- - ------------------- - - -- Iir_Kind_Entity_Declaration (Medium) - -- - -- Get/Set_Parent (Field0) - -- Get/Set_Design_Unit (Alias Field0) - -- - -- Get/Set_Declaration_Chain (Field1) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Concurrent_Statement_Chain (Field5) - -- - -- Get/Set_Generic_Chain (Field6) - -- - -- Get/Set_Port_Chain (Field7) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Is_Within_Flag (Flag5) - -- - -- Get/Set_End_Has_Reserved_Id (Flag8) - -- - -- Get/Set_End_Has_Identifier (Flag9) - -- - -- Get/Set_Has_Begin (Flag10) - - -- Iir_Kind_Architecture_Body (Medium) - -- - -- Get/Set_Parent (Field0) - -- Get/Set_Design_Unit (Alias Field0) - -- - -- Get/Set_Declaration_Chain (Field1) - -- - -- Name of the entity declaration for the architecture. - -- Get/Set_Entity_Name (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Concurrent_Statement_Chain (Field5) - -- - -- The default configuration created by canon. This is a design unit. - -- Get/Set_Default_Configuration_Declaration (Field6) - -- - -- Get/Set_Foreign_Flag (Flag3) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Is_Within_Flag (Flag5) - -- - -- Get/Set_End_Has_Reserved_Id (Flag8) - -- - -- Get/Set_End_Has_Identifier (Flag9) - - -- Iir_Kind_Configuration_Declaration (Medium) - -- - -- Get/Set_Parent (Field0) - -- Get/Set_Design_Unit (Alias Field0) - -- - -- Get/Set_Declaration_Chain (Field1) - -- - -- Name of the entity of a configuration. - -- Get/Set_Entity_Name (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Block_Configuration (Field5) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_End_Has_Reserved_Id (Flag8) - -- - -- Get/Set_End_Has_Identifier (Flag9) - - -- Iir_Kind_Package_Header (Medium) - -- - -- Get/Set_Generic_Chain (Field6) - -- - -- Get/Set_Generic_Map_Aspect_Chain (Field8) - - -- Iir_Kind_Package_Declaration (Short) - -- - -- Get/Set_Parent (Field0) - -- Get/Set_Design_Unit (Alias Field0) - -- - -- Get/Set_Declaration_Chain (Field1) - -- - -- Get/Set_Package_Body (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Package_Header (Field5) - -- - -- Get/Set_Need_Body (Flag1) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_End_Has_Reserved_Id (Flag8) - -- - -- Get/Set_End_Has_Identifier (Flag9) - - -- Iir_Kind_Package_Body (Short) - -- Note: a body is not a declaration, that's the reason why there is no - -- _declaration suffix in the name. - -- - -- Get/Set_Parent (Field0) - -- Get/Set_Design_Unit (Alias Field0) - -- - -- Get/Set_Declaration_Chain (Field1) - -- - -- Get/Set_Identifier (Field3) - -- - -- The corresponding package declaration. - -- Get/Set_Package (Field4) - -- - -- Get/Set_End_Has_Reserved_Id (Flag8) - -- - -- Get/Set_End_Has_Identifier (Flag9) - - -- Iir_Kind_Package_Instantiation_Declaration (Medium) - -- - -- Get/Set_Parent (Field0) - -- Get/Set_Design_Unit (Alias Field0) - -- - -- Get/Set_Declaration_Chain (Field1) - -- - -- Get/Set_Package_Body (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Uninstantiated_Package_Name (Field5) - -- - -- Get/Set_Generic_Chain (Field6) - -- - -- Get/Set_Generic_Map_Aspect_Chain (Field8) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_End_Has_Reserved_Id (Flag8) - -- - -- Get/Set_End_Has_Identifier (Flag9) - - -- Iir_Kind_Library_Declaration (Medium) - -- - -- Design files in the library. - -- Get/Set_Design_File_Chain (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- This node is used to contain all a library. Only internaly used. - -- Name (identifier) of the library. - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Date (Field10) - -- - -- Get/Set_Library_Directory (Field11) - -- - -- Get/Set_Visible_Flag (Flag4) - - -- Iir_Kind_Component_Declaration (Medium) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Generic_Chain (Field6) - -- - -- Get/Set_Port_Chain (Field7) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Use_Flag (Flag6) - -- - -- Get/Set_Has_Is (Flag7) - -- - -- Get/Set_End_Has_Reserved_Id (Flag8) - -- - -- Get/Set_End_Has_Identifier (Flag9) - - -- LRM08 6.6 Alias declarations - -- - -- alias_declaration ::= - -- ALIAS alias_designator [ : subtype_indication ] IS - -- name [ signature ] ; - -- - -- alias_designator ::= identifier | character_literal | operator_symbol - -- - -- Object aliases and non-object aliases are represented by two different - -- nodes, as their semantic is different. The parser only creates object - -- alias declaration nodes, but sem_decl replaces the node for non-object - -- alias declarations. - - -- Iir_Kind_Object_Alias_Declaration (Short) - -- - -- Get/Set_Parent (Field0) - -- - -- The type can be deduced from the subtype indication, but this field is - -- present for uniformity (and speed). - -- Get/Set_Type (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Name (Field4) - -- - -- The subtype indication may not be present. - -- Get/Set_Subtype_Indication (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_After_Drivers_Flag (Flag5) - -- - -- Get/Set_Use_Flag (Flag6) - -- - -- Get/Set_Is_Ref (Flag7) - - -- Iir_Kind_Non_Object_Alias_Declaration (Short) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Name (Field4) - -- - -- Get/Set_Alias_Signature (Field5) - -- - -- Set when the alias was implicitely created (by Sem) because of an - -- explicit alias of a type. - -- Get/Set_Implicit_Alias_Flag (Flag1) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Use_Flag (Flag6) - - -- Iir_Kind_Anonymous_Type_Declaration (Short) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Type_Definition (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Used for informative purpose only. - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Subtype_Definition (Field4) - - -- Iir_Kind_Type_Declaration (Short) - -- - -- LRM08 6.3 Type declarations - -- - -- type_declaration ::= - -- full_type_declaration - -- | incomplete_type_declaration - -- - -- full_type_declaration ::= - -- TYPE identifier IS type_definition ; - -- - -- type_definition ::= - -- scalar_type_definition - -- | composite_type_definition - -- | access_type_definition - -- | file_type_definition - -- | protected_type_definition - -- - -- LRM08 5.4.2 Incomplete type declarations - -- - -- incomplete_type_declaration ::= - -- TYPE identifier ; - -- - -- Get/Set_Parent (Field0) - -- - -- Definition of the type. - -- Note: the type definition can be a real type (unconstrained array, - -- enumeration, file, record, access) or a subtype (integer, floating - -- point). - -- The parser set this field to null_iir for an incomplete type - -- declaration. This field is set to an incomplete_type_definition node - -- when first semantized. - -- Get/Set_Type_Definition (Field1) - -- Get/Set_Type (Alias Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Use_Flag (Flag6) - - -- Iir_Kind_Subtype_Declaration (Short) - -- - -- LRM08 6.3 Subtype declarations - -- - -- subtype_declaration ::= - -- SUBTYPE identifier IS subtype_indication ; - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Subtype_Indication (Field5) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Use_Flag (Flag6) - -- - -- Get/Set_Is_Ref (Flag7) - - -- Iir_Kind_Nature_Declaration (Short) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Nature (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Use_Flag (Flag6) - - -- Iir_Kind_Subnature_Declaration (Short) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Nature (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Use_Flag (Flag6) - - -- Iir_Kind_Interface_Signal_Declaration (Medium) - -- Iir_Kind_Interface_Constant_Declaration (Medium) - -- Iir_Kind_Interface_Variable_Declaration (Medium) - -- Iir_Kind_Interface_File_Declaration (Medium) - -- - -- Get/Set the parent of an interface declaration. - -- The parent is an entity declaration, a subprogram specification, a - -- component declaration, a loop statement, a block declaration or ?? - -- Useful to distinguish a port and an interface. - -- Get/Set_Parent (Field0) - -- - -- The type can be deduced from the subtype indication, but this field is - -- present for uniformity (and speed). - -- Get/Set_Type (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Subtype_Indication (Field5) - -- - -- Must always be null_iir for iir_kind_interface_file_declaration. - -- Get/Set_Default_Value (Field6) - -- - -- Get/Set_Mode (Odigit1) - -- - -- Get/Set_Lexical_Layout (Odigit2) - -- - -- Only for Iir_Kind_Interface_Signal_Declaration: - -- Get/Set_Has_Disconnect_Flag (Flag1) - -- - -- Only for Iir_Kind_Interface_Signal_Declaration: - -- Get/Set_Has_Active_Flag (Flag2) - -- - -- Only for Iir_Kind_Interface_Signal_Declaration: - -- Get/Set_Open_Flag (Flag3) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_After_Drivers_Flag (Flag5) - -- - -- Get/Set_Use_Flag (Flag6) - -- - -- Get/Set_Is_Ref (Flag7) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - -- - -- Only for Iir_Kind_Interface_Signal_Declaration: - -- Get/Set_Signal_Kind (State3) - - -- Iir_Kind_Interface_Package_Declaration (Medium) - -- - -- LRM08 6.5.5 Interface package declarations - -- - -- interface_package_declaration ::= - -- PACKAGE identifier IS NEW /uninstantiated_package/_name - -- interface_package_generic_map_aspect - -- - -- interface_package_generic_map_aspect ::= - -- generic_map_aspect - -- | GENERIC MAP ( <> ) -- Represented by Null_Iir - -- | GENERIC MAP ( DEFAULT ) -- Not yet implemented - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Declaration_Chain (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Uninstantiated_Package_Name (Field5) - -- - -- Get/Set_Generic_Chain (Field6) - -- - -- Get/Set_Generic_Map_Aspect_Chain (Field8) - -- - -- Get/Set_Visible_Flag (Flag4) - - -- Iir_Kind_Function_Declaration (Medium) - -- Iir_Kind_Procedure_Declaration (Medium) - -- - -- LRM08 4.2 Subprogram declarations - -- - -- subprogram_declaration ::= subprogram_specification ; - -- - -- subprogram_specification ::= - -- procedure_specification | function_specification - -- - -- procedure_specification ::= - -- PROCEDURE designator - -- subprogram_header - -- [ [ PARAMETER ] ( formal_parameter_list ) ] - -- - -- function_specification ::= - -- [ PURE | IMPURE ] FUNCTION designator - -- subprogram_header - -- [ [ PARAMETER ] ( formal_parameter_list ) ] return type_mark - -- - -- designator ::= identifier | operator_symbol - -- - -- operator_symbol ::= string_literal - -- - -- Note: the subprogram specification of a body is kept, but should be - -- ignored if there is a subprogram declaration. The function - -- Is_Second_Subprogram_Specification returns True on such specification. - -- - -- The declaration containing this subrogram declaration. - -- Get/Set_Parent (Field0) - -- - -- Only for Iir_Kind_Function_Declaration: - -- Get/Set_Return_Type (Field1) - -- - -- Only for Iir_Kind_Function_Declaration: - -- Get/Set_Type (Alias Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Interface_Declaration_Chain (Field5) - -- - -- Get/Set_Generic_Chain (Field6) - -- - -- --Get/Set_Generic_Map_Aspect_Chain (Field8) - -- - -- Get/Set_Return_Type_Mark (Field8) - -- - -- Get/Set_Subprogram_Body (Field9) - -- - -- Get/Set_Subprogram_Depth (Field10) - -- - -- Get/Set_Subprogram_Hash (Field11) - -- - -- Get/Set_Overload_Number (Field12) - -- - -- Get/Set_Seen_Flag (Flag1) - -- - -- Only for Iir_Kind_Function_Declaration: - -- Get/Set_Pure_Flag (Flag2) - -- - -- Only for Iir_Kind_Procedure_Declaration: - -- Get/Set_Passive_Flag (Flag2) - -- - -- Get/Set_Foreign_Flag (Flag3) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Is_Within_Flag (Flag5) - -- - -- Get/Set_Use_Flag (Flag6) - -- - -- Only for Iir_Kind_Function_Declaration: - -- Get/Set_Resolution_Function_Flag (Flag7) - -- - -- Only for Iir_Kind_Function_Declaration: - -- Get/Set_Has_Pure (Flag8) - -- - -- True is the specification is immediately followed by a body. - -- Get/Set_Has_Body (Flag9) - -- - -- Get/Set_Wait_State (State1) - -- - -- Only for Iir_Kind_Procedure_Declaration: - -- Get/Set_Purity_State (State2) - -- - -- Get/Set_All_Sensitized_State (State3) - - -- Iir_Kind_Function_Body (Medium) - -- Iir_Kind_Procedure_Body (Medium) - -- - -- LRM08 4.3 Subprogram bodies - -- - -- subprogram_body ::= - -- subprogram_specification IS - -- subprogram_declarative_part - -- BEGIN - -- subprogram_statement_part - -- END [ subprogram_kind ] [ designator ] ; - -- - -- subprogram_kind ::= PROCEDURE | FUNCTION - -- - -- Get/Set_Parent (Field0) - -- - -- The parse stage always puts a declaration before a body. - -- Sem will remove the declaration if there is a forward declaration. - -- - -- Get/Set_Declaration_Chain (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Impure_Depth (Field3) - -- - -- Get/Set_Subprogram_Specification (Field4) - -- - -- Get/Set_Sequential_Statement_Chain (Field5) - -- - -- Get/Set_Callees_List (Field7) - -- - -- Get/Set_End_Has_Reserved_Id (Flag8) - -- - -- Get/Set_End_Has_Identifier (Flag9) - - -- Iir_Kind_Implicit_Procedure_Declaration (Medium) - -- Iir_Kind_Implicit_Function_Declaration (Medium) - -- - -- This node contains a subprogram_declaration that was implicitly defined - -- just after a type declaration. - -- This declaration is inserted by sem. - -- - -- Get/Set_Parent (Field0) - -- - -- Only for Iir_Kind_Implicit_Function_Declaration: - -- Get/Set_Return_Type (Field1) - -- - -- Only for Iir_Kind_Implicit_Function_Declaration: - -- Get/Set_Type (Alias Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Interface_Declaration_Chain (Field5) - -- - -- Get/Set_Generic_Chain (Field6) - -- - -- Get/Set_Generic_Map_Aspect_Chain (Field8) - -- - -- Get/Set_Implicit_Definition (Field9) - -- - -- Get/Set_Type_Reference (Field10) - -- - -- Get/Set_Subprogram_Hash (Field11) - -- - -- Get/Set_Overload_Number (Field12) - -- - -- Get/Set_Wait_State (State1) - -- - -- Get/Set_Seen_Flag (Flag1) - -- - -- Only for Iir_Kind_Implicit_Function_Declaration: - -- Get/Set_Pure_Flag (Flag2) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Is_Within_Flag (Flag5) - -- - -- Get/Set_Use_Flag (Flag6) - - -- Iir_Kind_Signal_Declaration (Medium) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Subtype_Indication (Field5) - -- - -- Get/Set_Default_Value (Field6) - -- - -- For a non-resolved signal: null_iir if the signal has no driver, or - -- a process/concurrent_statement for which the signal should have a - -- driver. This is used to catch at analyse time unresolved signals with - -- several drivers. - -- Get/Set_Signal_Driver (Field7) - -- - -- Get/Set_Has_Disconnect_Flag (Flag1) - -- - -- Get/Set_Has_Identifier_List (Flag3) - -- - -- Get/Set_Has_Active_Flag (Flag2) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_After_Drivers_Flag (Flag5) - -- - -- Get/Set_Use_Flag (Flag6) - -- - -- Get/Set_Is_Ref (Flag7) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - -- - -- Get/Set_Signal_Kind (State3) - - -- Iir_Kind_Guard_Signal_Declaration (Medium) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Guard_Expression (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Guard_Sensitivity_List (Field6) - -- - -- Get/Set_Block_Statement (Field7) - -- - -- Get/Set_Has_Active_Flag (Flag2) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Use_Flag (Flag6) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - -- - -- Get/Set_Signal_Kind (State3) - - -- Iir_Kind_Constant_Declaration (Medium) - -- Iir_Kind_Iterator_Declaration (Medium) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- For iterator, this is the reconstructed subtype indication. - -- Get/Set_Subtype_Indication (Field5) - -- - -- Only for Iir_Kind_Iterator_Declaration: - -- Get/Set_Discrete_Range (Field6) - -- - -- Only for Iir_Kind_Constant_Declaration: - -- Default value of a deferred constant points to the full constant - -- declaration. - -- Get/Set_Default_Value (Field6) - -- - -- Only for Iir_Kind_Constant_Declaration: - -- Summary: - -- | constant C1 : integer; -- Deferred declaration (in a package) - -- | constant C2 : integer := 4; -- Declaration - -- | constant C1 : integer := 3; -- Full declaration (in a body) - -- | NAME Deferred_declaration Deferred_declaration_flag - -- | C1 Null_iir or C1' (*) True - -- | C2 Null_Iir False - -- | C1' C1 False - -- |(*): Deferred_declaration is Null_Iir as long as the full declaration - -- | has not been analyzed. - -- Get/Set_Deferred_Declaration (Field7) - -- - -- Only for Iir_Kind_Constant_Declaration: - -- Get/Set_Deferred_Declaration_Flag (Flag1) - -- - -- Get/Set_Has_Identifier_List (Flag3) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Use_Flag (Flag6) - -- - -- Get/Set_Is_Ref (Flag7) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - -- Iir_Kind_Variable_Declaration (Medium) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Subtype_Indication (Field5) - -- - -- Get/Set_Default_Value (Field6) - -- - -- True if the variable is a shared variable. - -- Get/Set_Shared_Flag (Flag2) - -- - -- Get/Set_Has_Identifier_List (Flag3) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Use_Flag (Flag6) - -- - -- Get/Set_Is_Ref (Flag7) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - -- Iir_Kind_File_Declaration (Medium) - -- - -- LRM08 6.4.2.5 File declarations - -- - -- file_declaration ::= - -- FILE identifier_list : subtype_indication [ file_open_information ] ; - -- - -- file_open_information ::= - -- [ OPEN file_open_kind_expression ] IS file_logical_name - -- - -- file_logical_name ::= string_expression - -- - -- LRM87 - -- - -- file_declaration ::= - -- FILE identifier : subtype_indication IS [ mode ] file_logical_name ; - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Subtype_Indication (Field5) - -- - -- Get/Set_File_Logical_Name (Field6) - -- - -- This is not used in vhdl 87. - -- Get/Set_File_Open_Kind (Field7) - -- - -- This is used only in vhdl 87. - -- Get/Set_Mode (Odigit1) - -- - -- Get/Set_Has_Identifier_List (Flag3) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Use_Flag (Flag6) - -- - -- Get/Set_Is_Ref (Flag7) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - -- - -- Get/Set_Has_Mode (Flag8) - - -- Iir_Kind_Element_Declaration (Short) - -- - -- LRM08 5.3.3 Record types - -- - -- element_declaration ::= - -- identifier_list : element_subtype_definition ; - -- - -- identifier_list ::= identifier { , identifier } - -- - -- element_subtype_definition ::= subtype_indication - -- - -- The type can be deduced from the subtype indication, but this field is - -- present for uniformity (and speed). - -- Get/Set_Type (Field1) - -- - -- Get/Set_Identifier (Field3) - -- - -- Return the position of the element in the record, starting from 0 for - -- the first record element, increasing by one for each successive element. - -- Get/Set_Element_Position (Field4) - -- - -- Get/Set_Subtype_Indication (Field5) - -- - -- Get/Set_Has_Identifier_List (Flag3) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Is_Ref (Flag7) - - -- Iir_Kind_Record_Element_Constraint (Short) - -- - -- Record subtype definition which defines this constraint. - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Element_Declaration (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Return the position of the element in the record, starting from 0 for - -- the first record element, increasing by one for each successive element. - -- Get/Set_Element_Position (Field4) - -- - -- Get/Set_Visible_Flag (Flag4) - - -- Iir_Kind_Attribute_Declaration (Short) - -- - -- LRM08 6.7 Attribute declarations - -- - -- attribute_declaration ::= - -- ATTRIBUTE identifier : type_mark ; - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Type_Mark (Field4) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Use_Flag (Flag6) - - -- Iir_Kind_Group_Template_Declaration (Short) - -- - -- Get/Set_Parent (Field0) - -- - -- List of entity class entry. - -- To handle `<>', the last element of the list can be an entity_class of - -- kind tok_box. - -- Get/Set_Entity_Class_Entry_Chain (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Use_Flag (Flag6) - - -- Iir_Kind_Group_Declaration (Short) - -- - -- The declaration containing this type declaration. - -- Get/Set_Parent (Field0) - -- - -- List of constituents. - -- Get/Set_Group_Constituent_List (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Group_Template_Name (Field5) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Use_Flag (Flag6) - - -- Iir_Kind_Psl_Declaration (Medium) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Psl_Declaration (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Valid only for property declaration. - -- Get/Set_PSL_Clock (Field7) - -- - -- Valid only for property declaration without parameters. - -- Get/Set_PSL_NFA (Field8) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Use_Flag (Flag6) - - -- Iir_Kind_Terminal_Declaration (Short) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Nature (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Use_Flag (Flag6) - - -- Iir_Kind_Free_Quantity_Declaration (Medium) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Default_Value (Field6) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Use_Flag (Flag6) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - -- Iir_Kind_Across_Quantity_Declaration (Medium) - -- Iir_Kind_Through_Quantity_Declaration (Medium) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Default_Value (Field6) - -- - -- Get/Set_Tolerance (Field7) - -- - -- Get/Set_Plus_Terminal (Field8) - -- - -- Get/Set_Minus_Terminal (Field9) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Use_Flag (Flag6) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - -- Iir_Kind_Use_Clause (Short) - -- - -- LRM08 12.4 Use clauses - -- - -- use_clause ::= - -- USE selected_name { , selected_name } ; - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Selected_Name (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Use_Clause_Chain (Field3) - - - ----------------------- - -- type definitions -- - ----------------------- - - -- For Iir_Kinds_Type_And_Subtype_Definition: - -- - -- Type_Declarator: - -- Points to the type declaration or subtype declaration that has created - -- this definition. For some types, such as integer and floating point - -- types, both type and subtype points to the declaration. - -- However, there are cases where a type definition doesn't point to - -- a declarator: anonymous subtype created by index contraints, or - -- anonymous subtype created by an object declaration. - -- Note: a type definition cannot be anoynymous. - -- Get/Set_Type_Declarator (Field3) - -- - -- The base type. - -- For a subtype, it returns the type. - -- For a type, it must return the type itself. - -- Get/Set_Base_Type (Field4) - -- - -- The staticness of a type, according to LRM93 7.4.1. - -- Note: These types definition are always locally static: - -- enumeration, integer, floating. - -- However, their subtype are not necessary locally static. - -- Get/Set_Type_Staticness (State1) - -- - -- The resolved flag of a subtype, according to LRM93 2.4 - -- Get/Set_Resolved_Flag (Flag1) - -- - -- The signal_type flag of a type definition. - -- It is true when the type can be used for a signal. - -- Get/Set_Signal_Type_Flag (Flag2) - -- - -- Get/Set_Has_Signal_Flag (Flag3) - - -- Iir_Kind_Enumeration_Type_Definition (Short) - -- - -- Get the range of the type (This is just an ascending range from the - -- first literal to the last declared literal). - -- Get/Set_Range_Constraint (Field1) - -- - -- Return the list of literals. This list is created when the node is - -- created. - -- Get/Set_Enumeration_Literal_List (Field2) - -- - -- Get/Set_Type_Declarator (Field3) - -- - -- Get/Set_Base_Type (Field4) - -- - -- Get/Set_Resolved_Flag (Flag1) - -- - -- Get/Set_Signal_Type_Flag (Flag2) - -- - -- Get/Set_Has_Signal_Flag (Flag3) - -- - -- Get/Set_Only_Characters_Flag (Flag4) - -- - -- Get/Set_Type_Staticness (State1) - - -- Iir_Kind_Enumeration_Literal (Medium) - -- - -- Nota: two literals of the same type are equal iff their value is the - -- same; in other words, there may be severals literals with the same - -- value. - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Type (Field1) - -- Get/Set_Return_Type (Alias Field1) - -- - -- Get/Set_Literal_Origin (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- The declaration of the literal. If LITERAL_ORIGIN is not set, then this - -- is the node itself, else this is the literal defined. - -- Get/Set_Enumeration_Decl (Field6) - -- - -- The value of an enumeration literal is the position. - -- Get/Set_Enum_Pos (Field10) - -- - -- Get/Set_Subprogram_Hash (Field11) - -- - -- Get/Set_Seen_Flag (Flag1) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Never set to true, but possible when used as a prefix of an expanded - -- name in a overloaded subprogram. - -- Get/Set_Is_Within_Flag (Flag5) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - -- Iir_Kind_Physical_Type_Definition (Short) - -- - -- Get/Set_Unit_Chain (Field1) - -- Get/Set_Primary_Unit (Alias Field1) - -- - -- Get/Set_Type_Declarator (Field3) - -- - -- Get/Set_Base_Type (Field4) - -- - -- Get/Set_Resolved_Flag (Flag1) - -- - -- Get/Set_Signal_Type_Flag (Flag2) - -- - -- Get/Set_Has_Signal_Flag (Flag3) - -- - -- Get/Set_Type_Staticness (State1) - -- - -- Get/Set_End_Has_Reserved_Id (Flag8) - -- - -- Get/Set_End_Has_Identifier (Flag9) - - -- Iir_Kind_Unit_Declaration (Medium) - -- - -- LRM08 5.2.4 Physical types - -- - -- primary_unit_declaration ::= identifier ; - -- - -- secondary_unit_declaration ::= identifier = physical_literal ; - -- - -- physical_literal ::= [ abstract_literal ] /unit/_name - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- The Physical_Literal is the expression that appear in the sources, so - -- this is Null_Iir for a primary unit. - -- Get/Set_Physical_Literal (Field6) - -- - -- The value of the unit, computed from the primary unit. This is always - -- a physical integer literal. - -- Get/Set_Physical_Unit_Value (Field7) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - -- - -- Get/Set_Visible_Flag (Flag4) - - -- LRM08 5.2 Scalar types - -- - -- range_constraint ::= RANGE range - -- - -- range ::= - -- range_attribute_name - -- | simple_expression direction simple_expression - -- - -- direction ::= to | downto - - -- Iir_Kind_Integer_Type_Definition (Short) - -- Iir_Kind_Floating_Type_Definition (Short) - -- - -- The type declarator that has created this type. - -- Get/Set_Type_Declarator (Field3) - -- - -- Get/Set_Base_Type (Field4) - -- - -- Type staticness is always locally. - -- Get/Set_Type_Staticness (State1) - -- - -- Get/Set_Resolved_Flag (Flag1) - -- - -- Get/Set_Signal_Type_Flag (Flag2) - -- - -- Get/Set_Has_Signal_Flag (Flag3) - - -- Iir_Kind_Array_Type_Definition (Medium) - -- - -- LRM08 5.3.2 Array types / LRM93 3.2.1 - -- - -- unbounded_array_definition ::= - -- ARRAY ( index_subtype_definition { , index_subtype_definition } ) - -- OF element_subtype_indication - -- - -- index_subtype_definition ::= type_mark RANGE <> - -- - -- Get/Set_Element_Subtype (Field1) - -- - -- Get/Set_Element_Subtype_Indication (Field2) - -- - -- Get/Set_Type_Declarator (Field3) - -- - -- Get/Set_Base_Type (Field4) - -- - -- This is a list of type marks. - -- Get/Set_Index_Subtype_Definition_List (Field6) - -- - -- Same as the index_subtype_definition_list. - -- Get/Set_Index_Subtype_List (Field9) - -- - -- Get/Set_Type_Staticness (State1) - -- - -- Get/Set_Constraint_State (State2) - -- - -- Get/Set_Resolved_Flag (Flag1) - -- - -- Get/Set_Signal_Type_Flag (Flag2) - -- - -- Get/Set_Has_Signal_Flag (Flag3) - -- - -- Get/Set_Index_Constraint_Flag (Flag4) - - -- Iir_Kind_Record_Type_Definition (Short) - -- - -- LRM08 5.3.3 Record types / LRM93 3.2.2 Record types - -- - -- record_type_definition ::= - -- RECORD - -- element_declaration - -- { element_declaration } - -- END RECORD [ /record_type/_simple_name ] - -- - -- Get/Set_Elements_Declaration_List (Field1) - -- - -- Get/Set_Type_Declarator (Field3) - -- - -- Get/Set_Base_Type (Field4) - -- - -- Get/Set_Type_Staticness (State1) - -- - -- Get/Set_Constraint_State (State2) - -- - -- Get/Set_Resolved_Flag (Flag1) - -- - -- Get/Set_Signal_Type_Flag (Flag2) - -- - -- Get/Set_Has_Signal_Flag (Flag3) - -- - -- Get/Set_End_Has_Reserved_Id (Flag8) - -- - -- Get/Set_End_Has_Identifier (Flag9) - - -- Iir_Kind_Access_Type_Definition (Short) - -- - -- LRM08 5.4 Access types - -- - -- access_type_definition ::= ACCESS subtype_indication - -- - -- Get/Set_Designated_Type (Field1) - -- - -- Get/Set_Designated_Subtype_Indication (Field5) - -- - -- Get/Set_Type_Declarator (Field3) - -- - -- Get/Set_Base_Type (Field4) - -- - -- Get/Set_Resolved_Flag (Flag1) - -- - -- Get/Set_Signal_Type_Flag (Flag2) - -- - -- Get/Set_Type_Staticness (State1) - - -- Iir_Kind_File_Type_Definition (Short) - -- - -- Get/Set_File_Type_Mark (Field2) - -- - -- Get/Set_Type_Declarator (Field3) - -- - -- Get/Set_Base_Type (Field4) - -- - -- Get/Set_Resolved_Flag (Flag1) - -- - -- Get/Set_Signal_Type_Flag (Flag2) - -- - -- True if this is the std.textio.text file type, which may require special - -- handling. - -- Get/Set_Text_File_Flag (Flag4) - -- - -- Get/Set_Type_Staticness (State1) - - -- Iir_Kind_Incomplete_Type_Definition (Short) - -- Type definition for an incomplete type. This is created during the - -- semantisation of the incomplete type declaration. - -- - -- Get/Set_Incomplete_Type_List (Field2) - -- - -- Set to the incomplete type declaration when semantized, and set to the - -- complete type declaration when the latter one is semantized. - -- Get/Set_Type_Declarator (Field3) - -- - -- Get/Set_Base_Type (Field4) - -- - -- Get/Set_Type_Staticness (State1) - -- - -- Get/Set_Resolved_Flag (Flag1) - -- - -- Get/Set_Signal_Type_Flag (Flag2) - -- - -- Get/Set_Has_Signal_Flag (Flag3) - - -- Iir_Kind_Protected_Type_Declaration (Short) - -- - -- Get/Set_Declaration_Chain (Field1) - -- - -- Get/Set_Protected_Type_Body (Field2) - -- - -- Get/Set_Type_Declarator (Field3) - -- - -- Get/Set_Base_Type (Field4) - -- - -- Get/Set_Type_Staticness (State1) - -- - -- Get/Set_Resolved_Flag (Flag1) - -- - -- Get/Set_Signal_Type_Flag (Flag2) - -- - -- Get/Set_End_Has_Reserved_Id (Flag8) - -- - -- Get/Set_End_Has_Identifier (Flag9) - - -- Iir_Kind_Protected_Type_Body (Short) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Declaration_Chain (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Protected_Type_Declaration (Field4) - -- - -- Get/Set_End_Has_Reserved_Id (Flag8) - -- - -- Get/Set_End_Has_Identifier (Flag9) - - -------------------------- - -- subtype definitions -- - -------------------------- - - -- LRM08 6.3 Subtype declarations - -- - -- subtype_indication ::= - -- [ resolution_indication ] type_mark [ constraint ] - -- - -- There is no uniq representation for a subtype indication. If there is - -- only a type_mark, then a subtype indication is represented by a name - -- (a simple name or an expanded name); otherwise it is represented by one - -- of the subtype definition node. - -- - -- resolution_indication ::= - -- resolution_function_name | ( element_resolution ) - -- - -- element_resolution ::= array_element_resolution | record_resolution - -- - -- If there is no constraint but a resolution function name, the subtype - -- indication is represented by a subtype_definition (which will be - -- replaced by the correct subtype definition). If there is an array - -- element resolution the subtype indication is represented by an array - -- subtype definition, and if there is a record resolution, it is - -- represented by a record subtype definition. - -- - -- constraint ::= - -- range_constraint - -- | index_constraint - -- | array_constraint - -- | record_constraint - -- - -- There is no node for constraint, it is directly represented by one of - -- the rhs. - -- - -- element_constraint ::= - -- array_constraint - -- | record_constraint - -- - -- Likewise, there is no node for element_constraint. - -- - -- index_constraint ::= ( discrete_range { , discrete_range } ) - -- - -- An index_constraint is represented by an array_subtype_definition. - -- - -- discrete_range ::= /discrete/_subtype_indication | range - -- - -- array_constraint ::= - -- index_constraint [ array_element_constraint ] - -- | ( OPEN ) [ array_element_constraint ] - -- - -- An array_constraint is also represented by an array_subtype_definition. - -- - -- array_element_constraint ::= element_constraint - -- - -- There is no node for array_element_constraint. - -- - -- record_constraint ::= - -- ( record_element_constraint { , record_element_constraint } ) - -- - -- A record_constraint is represented by a record_subtype_definition. - -- - -- record_element_constraint ::= - -- record_element_simple_name element_constraint - -- - -- Represented by Record_Element_Constraint. - - -- Iir_Kind_Enumeration_Subtype_Definition (Short) - -- Iir_Kind_Integer_Subtype_Definition (Short) - -- Iir_Kind_Physical_Subtype_Definition (Short) - -- - -- Get/Set_Range_Constraint (Field1) - -- - -- Get/Set_Subtype_Type_Mark (Field2) - -- - -- Get/Set_Type_Declarator (Field3) - -- - -- Get/Set_Base_Type (Field4) - -- - -- Get/Set_Resolution_Indication (Field5) - -- - -- Get/Set_Resolved_Flag (Flag1) - -- - -- Get/Set_Signal_Type_Flag (Flag2) - -- - -- Get/Set_Has_Signal_Flag (Flag3) - -- - -- Get/Set_Type_Staticness (State1) - - -- Iir_Kind_Floating_Subtype_Definition (Medium) - -- - -- Get/Set_Range_Constraint (Field1) - -- - -- Get/Set_Subtype_Type_Mark (Field2) - -- - -- Get/Set_Type_Declarator (Field3) - -- - -- Get/Set_Base_Type (Field4) - -- - -- Get/Set_Resolution_Indication (Field5) - -- - -- Get/Set_Tolerance (Field7) - -- - -- Get/Set_Resolved_Flag (Flag1) - -- - -- Get/Set_Signal_Type_Flag (Flag2) - -- - -- Get/Set_Has_Signal_Flag (Flag3) - -- - -- Get/Set_Type_Staticness (State1) - - -- Iir_Kind_Access_Subtype_Definition (Short) - -- - -- Get/Set_Designated_Type (Field1) - -- - -- Get/Set_Subtype_Type_Mark (Field2) - -- - -- Get/Set_Type_Declarator (Field3) - -- - -- Get/Set_Base_Type (Field4) - -- - -- Get/Set_Designated_Subtype_Indication (Field5) - -- - -- Note: no resolution function for access subtype. - -- - -- Get/Set_Type_Staticness (State1) - -- - -- Get/Set_Resolved_Flag (Flag1) - -- - -- Get/Set_Signal_Type_Flag (Flag2) - - -- Iir_Kind_Array_Element_Resolution (Short) - -- - -- LRM08 6.3 Subtype declarations - -- - -- array_element_resolution ::= resolution_indication - -- - -- Get/Set_Resolution_Indication (Field5) - - -- Iir_Kind_Record_Resolution (Short) - -- - -- LRM08 6.3 Subtype declarations - -- - -- record_resolution ::= - -- record_element_resolution { , record_element_resolution } - -- - -- Get/Set_Record_Element_Resolution_Chain (Field1) - - -- Iir_Kind_Record_Element_Resolution (Short) - -- - -- LRM08 6.3 Subtype declarations - -- - -- record_element_resolution ::= - -- /record_element/_simple_name resolution_indication - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Resolution_Indication (Field5) - - -- Iir_Kind_Record_Subtype_Definition (Medium) - -- - -- Get/Set_Elements_Declaration_List (Field1) - -- - -- Get/Set_Subtype_Type_Mark (Field2) - -- - -- Get/Set_Type_Declarator (Field3) - -- - -- Get/Set_Base_Type (Field4) - -- - -- Get/Set_Resolution_Indication (Field5) - -- - -- Get/Set_Tolerance (Field7) - -- - -- Get/Set_Resolved_Flag (Flag1) - -- - -- Get/Set_Signal_Type_Flag (Flag2) - -- - -- Get/Set_Has_Signal_Flag (Flag3) - -- - -- Get/Set_Type_Staticness (State1) - -- - -- Get/Set_Constraint_State (State2) - - -- Iir_Kind_Array_Subtype_Definition (Medium) - -- - -- Get/Set_Element_Subtype (Field1) - -- - -- Get/Set_Subtype_Type_Mark (Field2) - -- - -- Get/Set_Type_Declarator (Field3) - -- - -- Get/Set_Base_Type (Field4) - -- - -- Get/Set_Resolution_Indication (Field5) - -- - -- The index_constraint list as it appears in the subtype indication (if - -- present). This is a list of subtype indication. - -- Get/Set_Index_Constraint_List (Field6) - -- - -- Get/Set_Tolerance (Field7) - -- - -- Get/Set_Array_Element_Constraint (Field8) - -- - -- The type of the index. This is either the index_constraint list or the - -- index subtypes of the type_mark. - -- Get/Set_Index_Subtype_List (Field9) - -- - -- Get/Set_Type_Staticness (State1) - -- - -- Get/Set_Constraint_State (State2) - -- - -- Get/Set_Resolved_Flag (Flag1) - -- - -- Get/Set_Signal_Type_Flag (Flag2) - -- - -- Get/Set_Has_Signal_Flag (Flag3) - -- - -- Get/Set_Index_Constraint_Flag (Flag4) - - -- Iir_Kind_Range_Expression (Short) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Left_Limit (Field2) - -- - -- Get/Set_Right_Limit (Field3) - -- - -- Get/Set_Range_Origin (Field4) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Direction (State2) - - -- Iir_Kind_Subtype_Definition (Medium) - -- Such a node is only created by parse and transformed into the correct - -- kind (enumeration_subtype, integer_subtype...) by sem. - -- - -- Get/Set_Range_Constraint (Field1) - -- - -- Get/Set_Subtype_Type_Mark (Field2) - -- - -- Get/Set_Resolution_Indication (Field5) - -- - -- Get/Set_Tolerance (Field7) - - ------------------------- - -- Nature definitions -- - ------------------------- - - -- Iir_Kind_Scalar_Nature_Definition (Medium) - -- - -- Get/Set_Reference (Field2) - -- - -- The declarator that has created this nature type. - -- Get/Set_Nature_Declarator (Field3) - -- - -- C-- Get/Set_Base_Type (Field4) - -- - -- Type staticness is always locally. - -- C-- Get/Set_Type_Staticness (State1) - -- - -- Get/Set_Across_Type (Field7) - -- - -- Get/Set_Through_Type (Field8) - - ---------------------------- - -- concurrent statements -- - ---------------------------- - - -- Iir_Kind_Concurrent_Conditional_Signal_Assignment (Medium) - -- Iir_Kind_Concurrent_Selected_Signal_Assignment (Medium) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Target (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Label (Field3) - -- Get/Set_Identifier (Alias Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Only for Iir_Kind_Concurrent_Selected_Signal_Assignment: - -- Get/Set_Expression (Field5) - -- - -- Get/Set_Reject_Time_Expression (Field6) - -- - -- Only for Iir_Kind_Concurrent_Conditional_Signal_Assignment: - -- Get/Set_Conditional_Waveform_Chain (Field7) - -- - -- Only for Iir_Kind_Concurrent_Selected_Signal_Assignment: - -- Get/Set_Selected_Waveform_Chain (Field7) - -- - -- If the assignment is guarded, then get_guard must return the - -- declaration of the signal guard, otherwise, null_iir. - -- If the guard signal decl is not known, as a kludge and only to mark this - -- assignment guarded, the guard can be this assignment. - -- Get/Set_Guard (Field8) - -- - -- Get/Set_Delay_Mechanism (Field12) - -- - -- Get/Set_Postponed_Flag (Flag3) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- True if the target of the assignment is guarded - -- Get/Set_Guarded_Target_State (State3) - - -- Iir_Kind_Sensitized_Process_Statement (Medium) - -- Iir_Kind_Process_Statement (Medium) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Declaration_Chain (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Label (Field3) - -- Get/Set_Identifier (Alias Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Sequential_Statement_Chain (Field5) - -- - -- Only for Iir_Kind_Sensitized_Process_Statement: - -- Get/Set_Sensitivity_List (Field6) - -- - -- Get/Set_Callees_List (Field7) - -- - -- The concurrent statement at the origin of that process. This is - -- Null_Iir for a user process. - -- Get/Set_Process_Origin (Field8) - -- - -- Get/Set_Wait_State (State1) - -- - -- Get/Set_Seen_Flag (Flag1) - -- - -- Get/Set_Passive_Flag (Flag2) - -- - -- Get/Set_Postponed_Flag (Flag3) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Is_Within_Flag (Flag5) - -- - -- Get/Set_Has_Is (Flag7) - -- - -- Get/Set_End_Has_Reserved_Id (Flag8) - -- - -- Get/Set_End_Has_Identifier (Flag9) - -- - -- Get/Set_End_Has_Postponed (Flag10) - - -- Iir_Kind_Concurrent_Assertion_Statement (Medium) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Assertion_Condition (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Label (Field3) - -- Get/Set_Identifier (Alias Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Severity_Expression (Field5) - -- - -- Get/Set_Report_Expression (Field6) - -- - -- Get/Set_Postponed_Flag (Flag3) - -- - -- Get/Set_Visible_Flag (Flag4) - - -- Iir_Kind_Psl_Default_Clock (Short) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Psl_Boolean (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Label (Field3) - -- Get/Set_Identifier (Alias Field3) - - -- Iir_Kind_Psl_Assert_Statement (Medium) - -- Iir_Kind_Psl_Cover_Statement (Medium) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Psl_Property (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Label (Field3) - -- Get/Set_Identifier (Alias Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Severity_Expression (Field5) - -- - -- Get/Set_Report_Expression (Field6) - -- - -- Get/Set_PSL_Clock (Field7) - -- - -- Get/Set_PSL_NFA (Field8) - -- - -- Get/Set_Visible_Flag (Flag4) - - -- Iir_Kind_Component_Instantiation_Statement (Medium) - -- - -- LRM08 11.7 Component instantiation statements - -- - -- component_instantiation_statement ::= - -- instantiation_label : - -- instantiated_unit - -- [ generic_map_aspect ] - -- [ port_map_aspect ] ; - -- - -- instantiated_unit ::= - -- [ COMPONENT ] component_name - -- | ENTITY entity_name [ ( architecture_identifier ) ] - -- | CONFIGURATION configuration_name - -- - -- Get/Set_Parent (Field0) - -- - -- Unit instantiated. This is a name, an entity_aspect_entity or an - -- entity_aspect_configuration. - -- Get/Set_Instantiated_Unit (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Label (Field3) - -- Get/Set_Identifier (Alias Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Default_Binding_Indication (Field5) - -- - -- Get/Set_Generic_Map_Aspect_Chain (Field8) - -- - -- Get/Set_Port_Map_Aspect_Chain (Field9) - -- - -- Configuration: - -- In case of a configuration specification, the node is put into - -- default configuration. In the absence of a specification, the - -- default entity aspect, if any; if none, this field is null_iir. - -- Get/Set_Configuration_Specification (Field7) - -- - -- During Sem and elaboration, the configuration field can be filled by - -- a component configuration declaration. - -- - -- Configuration for this component. - -- FIXME: must be get/set_binding_indication. - -- Get/Set_Component_Configuration (Field6) - -- - -- Get/Set_Visible_Flag (Flag4) - - -- Iir_Kind_Block_Statement (Medium) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Declaration_Chain (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Label (Field3) - -- Get/Set_Identifier (Alias Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Concurrent_Statement_Chain (Field5) - -- - -- Get/Set_Block_Block_Configuration (Field6) - -- - -- Get/Set_Block_Header (Field7) - -- - -- get/set_guard_decl is used for semantic analysis, in order to add - -- a signal declaration. - -- Get/Set_Guard_Decl (Field8) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Is_Within_Flag (Flag5) - -- - -- Get/Set_End_Has_Reserved_Id (Flag8) - -- - -- Get/Set_End_Has_Identifier (Flag9) - - -- Iir_Kind_Generate_Statement (Medium) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Declaration_Chain (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Label (Field3) - -- Get/Set_Identifier (Alias Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Concurrent_Statement_Chain (Field5) - -- - -- The generation scheme. - -- A (boolean) expression for a conditionnal elaboration (if). - -- A (iterator) declaration for an iterative elaboration (for). - -- Get/Set_Generation_Scheme (Field6) - -- - -- The block configuration for this statement. - -- Get/Set_Generate_Block_Configuration (Field7) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_End_Has_Reserved_Id (Flag8) - -- - -- Get/Set_End_Has_Identifier (Flag9) - -- - -- Get/Set_Has_Begin (Flag10) - - -- Iir_Kind_Simple_Simultaneous_Statement (Medium) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Label (Field3) - -- Get/Set_Identifier (Alias Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Simultaneous_Left (Field5) - -- - -- Get/Set_Simultaneous_Right (Field6) - -- - -- Get/Set_Tolerance (Field7) - -- - -- Get/Set_Visible_Flag (Flag4) - - ---------------------------- - -- sequential statements -- - ---------------------------- - - -- Iir_Kind_If_Statement (Medium) - -- Iir_Kind_Elsif (Medium) - -- - -- Get/Set_Parent (Field0) - -- - -- May be NULL only for an iir_kind_elsif node, and then means the else - -- clause. - -- Get/Set_Condition (Field1) - -- - -- Only for Iir_Kind_If_Statement: - -- Get/Set_Chain (Field2) - -- - -- Only for Iir_Kind_If_Statement: - -- Get/Set_Label (Field3) - -- - -- Only for Iir_Kind_If_Statement: - -- Get/Set_Identifier (Alias Field3) - -- - -- Only for Iir_Kind_If_Statement: - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Sequential_Statement_Chain (Field5) - -- - -- Must be an Iir_kind_elsif node, or NULL for no more elsif clauses. - -- Get/Set_Else_Clause (Field6) - -- - -- Only for Iir_Kind_If_Statement: - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_End_Has_Identifier (Flag9) - - -- LRM08 10.10 Loop statement / LRM93 8.9 - -- - -- loop_statement ::= - -- [ loop_label : ] - -- [ iteration_scheme ] LOOP - -- sequence_of_statements - -- END LOOP [ loop_label ] ; - -- - -- iteration_scheme ::= - -- WHILE condition - -- | FOR loop_parameter_specification - -- - -- parameter_specification ::= - -- identifier IN discrete_range - - -- Iir_Kind_For_Loop_Statement (Short) - -- - -- Get/Set_Parent (Field0) - -- - -- The parameters specification is represented by an Iterator_Declaration. - -- Get/Set_Parameter_Specification (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Label (Field3) - -- Get/Set_Identifier (Alias Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Sequential_Statement_Chain (Field5) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_Is_Within_Flag (Flag5) - -- - -- Get/Set_End_Has_Identifier (Flag9) - - -- Iir_Kind_While_Loop_Statement (Short) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Condition (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Label (Field3) - -- Get/Set_Identifier (Alias Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Sequential_Statement_Chain (Field5) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_End_Has_Identifier (Flag9) - - -- Iir_Kind_Exit_Statement (Short) - -- Iir_Kind_Next_Statement (Short) - -- - -- LRM08 10.11 Next statement - -- - -- next_statement ::= - -- [ label : ] NEXT [ loop_label ] [ WHEN condition ] ; - -- - -- LRM08 10.12 Exit statement - -- - -- exit_statement ::= - -- [ label : ] exit [ loop_label ] [ when condition ] ; - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Condition (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Label (Field3) - -- Get/Set_Identifier (Alias Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Loop_Label (Field5) - -- - -- Get/Set_Visible_Flag (Flag4) - - -- Iir_Kind_Signal_Assignment_Statement (Medium) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Target (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Label (Field3) - -- Get/Set_Identifier (Alias Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- The waveform. - -- If the waveform_chain is null_iir, then the signal assignment is a - -- disconnection statement, ie TARGET <= null_iir after disconection_time, - -- where disconnection_time is specified by a disconnection specification. - -- Get/Set_Waveform_Chain (Field5) - -- - -- Get/Set_Reject_Time_Expression (Field6) - -- - -- Get/Set_Delay_Mechanism (Field12) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- True if the target of the assignment is guarded - -- Get/Set_Guarded_Target_State (State3) - - -- Iir_Kind_Variable_Assignment_Statement (Short) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Target (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Label (Field3) - -- Get/Set_Identifier (Alias Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Expression (Field5) - -- - -- Get/Set_Visible_Flag (Flag4) - - -- Iir_Kind_Assertion_Statement (Medium) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Assertion_Condition (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Label (Field3) - -- Get/Set_Identifier (Alias Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Severity_Expression (Field5) - -- - -- Get/Set_Report_Expression (Field6) - -- - -- Get/Set_Visible_Flag (Flag4) - - -- Iir_Kind_Report_Statement (Medium) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Label (Field3) - -- Get/Set_Identifier (Alias Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Severity_Expression (Field5) - -- - -- Get/Set_Report_Expression (Field6) - -- - -- Get/Set_Visible_Flag (Flag4) - - -- Iir_Kind_Wait_Statement (Medium) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Timeout_Clause (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Label (Field3) - -- Get/Set_Identifier (Alias Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Condition_Clause (Field5) - -- - -- Get/Set_Sensitivity_List (Field6) - -- - -- Get/Set_Visible_Flag (Flag4) - - -- Iir_Kind_Return_Statement (Short) - -- - -- Get/Set_Parent (Field0) - -- - -- Type of the return value of the function. This is a copy of - -- return_type. - -- Get/Set_Type (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Label (Field3) - -- Get/Set_Identifier (Alias Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Expression (Field5) - -- - -- Get/Set_Visible_Flag (Flag4) - - -- Iir_Kind_Case_Statement (Short) - -- - -- Get/Set_Parent (Field0) - -- - -- Chain is compose of Iir_Kind_Choice_By_XXX. - -- Get/Set_Case_Statement_Alternative_Chain (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Label (Field3) - -- Get/Set_Identifier (Alias Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Expression (Field5) - -- - -- Get/Set_Visible_Flag (Flag4) - -- - -- Get/Set_End_Has_Identifier (Flag9) - - -- Iir_Kind_Procedure_Call_Statement (Short) - -- Iir_Kind_Concurrent_Procedure_Call_Statement (Short) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Procedure_Call (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Label (Field3) - -- Get/Set_Identifier (Alias Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Only for Iir_Kind_Concurrent_Procedure_Call_Statement: - -- Get/Set_Postponed_Flag (Flag3) - -- - -- Get/Set_Visible_Flag (Flag4) - - -- Iir_Kind_Procedure_Call (Short) - -- - -- Get/Set_Prefix (Field0) - -- - -- Get/Set_Parameter_Association_Chain (Field2) - -- - -- Procedure declaration corresponding to the procedure to call. - -- Get/Set_Implementation (Field3) - -- - -- Get/Set_Method_Object (Field4) - - -- Iir_Kind_Null_Statement (Short) - -- - -- Get/Set_Parent (Field0) - -- - -- Get/Set_Chain (Field2) - -- - -- Get/Set_Label (Field3) - -- Get/Set_Identifier (Alias Field3) - -- - -- Get/Set_Attribute_Value_Chain (Field4) - -- - -- Get/Set_Visible_Flag (Flag4) - - ---------------- - -- operators -- - ---------------- - - -- Iir_Kinds_Monadic_Operator (Short) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Operand (Field2) - -- - -- Function declaration corresponding to the function to call. - -- Get/Set_Implementation (Field3) - -- - -- Expr_staticness is defined by §7.4 - -- Get/Set_Expr_Staticness (State1) - - -- Iir_Kinds_Dyadic_Operator (Short) - -- - -- Get/Set_Type (Field1) - -- - -- Left and Right operands. - -- Get/Set_Left (Field2) - -- - -- Function declaration corresponding to the function to call. - -- Get/Set_Implementation (Field3) - -- - -- Get/Set_Right (Field4) - -- - -- Get/Set_Expr_Staticness (State1) - - -- Iir_Kind_Function_Call (Short) - -- - -- Get/Set_Prefix (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Parameter_Association_Chain (Field2) - -- - -- Function declaration corresponding to the function to call. - -- Get/Set_Implementation (Field3) - -- - -- Get/Set_Method_Object (Field4) - -- - -- Get/Set_Base_Name (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - -- Iir_Kind_Aggregate (Short) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Aggregate_Info (Field2) - -- - -- Get/Set_Association_Choices_Chain (Field4) - -- - -- Same as Type, but marked as property of that node. - -- Get/Set_Literal_Subtype (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Value_Staticness (State2) - - -- Iir_Kind_Aggregate_Info (Short) - -- - -- Get info for the next dimension. NULL_IIR terminated. - -- Get/Set_Sub_Aggregate_Info (Field1) - -- - -- For array aggregate only: - -- If TRUE, the choices are not locally static. - -- This flag is only valid when the array aggregate is constrained, ie - -- has no 'others' choice. - -- Get/Set_Aggr_Dynamic_Flag (Flag3) - -- - -- If TRUE, the aggregate is named, else it is positionnal. - -- Get/Set_Aggr_Named_Flag (Flag4) - -- - -- The following three fields are used to check bounds of an array - -- aggregate. - -- For named aggregate, low and high bounds are computed, for positionnal - -- aggregate, the (minimum) number of elements is computed. - -- Note there may be elements beyond the bounds, due to other choice. - -- These fields may apply for the aggregate or for the aggregate and its - -- brothers if the node is for a sub-aggregate. - -- - -- The low and high index choice, if any. - -- Get/Set_Aggr_Low_Limit (Field2) - -- - -- Get/Set_Aggr_High_Limit (Field3) - -- - -- The minimum number of elements, if any. This is a minimax. - -- Get/Set_Aggr_Min_Length (Field4) - -- - -- True if the choice list has an 'others' choice. - -- Get/Set_Aggr_Others_Flag (Flag2) - - -- Iir_Kind_Parenthesis_Expression (Short) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Expression (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - - -- Iir_Kind_Qualified_Expression (Short) - -- - -- LRM08 9.3.5 Qualified expressions - -- - -- qualified_expression ::= - -- type_mark ' ( expression ) - -- | type_mark ' aggregate - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Type_Mark (Field4) - -- - -- Get/Set_Expression (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - - -- Iir_Kind_Type_Conversion (Short) - -- - -- LRM08 9.3.6 Type conversions - -- - -- type_conversion ::= type_mark ( expression ) - -- - -- Get/Set_Type (Field1) - -- - -- If the type mark denotes an unconstrained array and the expression is - -- locally static, the result should be locally static according to vhdl93 - -- (which is not clear on that point). As a subtype is created, it is - -- referenced by this field. - -- Get/Set_Type_Conversion_Subtype (Field3) - -- - -- Get/Set_Type_Mark (Field4) - -- - -- Get/Set_Expression (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - - -- Iir_Kind_Allocator_By_Expression (Short) - -- Iir_Kind_Allocator_By_Subtype (Short) - -- - -- LRM08 9.3.7 Allocators - -- - -- allocator ::= - -- NEW subtype_indication - -- | NEW qualified_expression - -- - -- Get/Set_Type (Field1) - -- - -- To ease analysis: set to the designated type (either the type of the - -- expression or the subtype) - -- Get/Set_Allocator_Designated_Type (Field2) - -- - -- Only for Iir_Kind_Allocator_By_Expression: - -- Contains the expression for a by expression allocator. - -- Get/Set_Expression (Field5) - -- - -- Only for Iir_Kind_Allocator_By_Subtype: - -- Contains the subtype indication for a by subtype allocator. - -- Get/Set_Subtype_Indication (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - - ------------ - -- Names -- - ------------ - - -- Iir_Kind_Simple_Name (Short) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Alias_Declaration (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Named_Entity (Field4) - -- - -- Get/Set_Base_Name (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - -- Iir_Kind_Character_Literal (Short) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Alias_Declaration (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Named_Entity (Field4) - -- - -- Get/Set_Base_Name (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - -- Iir_Kind_Operator_Symbol (Short) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Alias_Declaration (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Named_Entity (Field4) - -- - -- Get/Set_Base_Name (Field5) - - -- Iir_Kind_Selected_Name (Short) - -- - -- Get/Set_Prefix (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Alias_Declaration (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Named_Entity (Field4) - -- - -- Get/Set_Base_Name (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - -- Iir_Kind_Selected_By_All_Name (Short) - -- - -- Get/Set_Prefix (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Named_Entity (Field4) - -- - -- Get/Set_Base_Name (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - - -- Iir_Kind_Indexed_Name (Short) - -- Select the element designed with the INDEX_LIST from array PREFIX. - -- - -- Get/Set_Prefix (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Index_List (Field2) - -- - -- Get/Set_Base_Name (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - -- Iir_Kind_Slice_Name (Short) - -- - -- Get/Set_Prefix (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Suffix (Field2) - -- - -- Get/Set_Slice_Subtype (Field3) - -- - -- Get/Set_Base_Name (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - -- Iir_Kind_Parenthesis_Name (Short) - -- Created by the parser, and mutated into the correct iir node: it can be - -- either a function call, an indexed array, a type conversion or a slice - -- name. - -- - -- Get/Set_Prefix (Field0) - -- - -- Always returns null_iir. - -- Get/Set_Type (Field1) - -- - -- Get/Set_Association_Chain (Field2) - -- - -- Get/Set_Named_Entity (Field4) - - -- Iir_Kind_Selected_Element (Short) - -- A record element selection. This corresponds to a reffined selected - -- names. The production doesn't exist in the VHDL grammar. - -- - -- Get/Set_Prefix (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Selected_Element (Field2) - -- - -- Get/Set_Base_Name (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - -- Iir_Kind_Implicit_Dereference (Short) - -- Iir_Kind_Dereference (Short) - -- An implicit access dereference. - -- - -- Get/Set_Prefix (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Base_Name (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - ----------------- - -- Attributes -- - ----------------- - - -- Iir_Kind_Attribute_Name (Short) - -- - -- Get/Set_Prefix (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Attribute_Signature (Field2) - -- - -- Get/Set_Identifier (Field3) - -- - -- Get/Set_Named_Entity (Field4) - -- - -- Get/Set_Base_Name (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - -- Iir_Kind_Base_Attribute (Short) - -- - -- Get/Set_Prefix (Field0) - -- - -- Get/Set_Type (Field1) - - -- Iir_Kind_Left_Type_Attribute (Short) - -- Iir_Kind_Right_Type_Attribute (Short) - -- Iir_Kind_High_Type_Attribute (Short) - -- Iir_Kind_Low_Type_Attribute (Short) - -- Iir_Kind_Ascending_Type_Attribute (Short) - -- - -- Get/Set_Prefix (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Base_Name (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - -- Iir_Kind_Range_Array_Attribute (Short) - -- Iir_Kind_Reverse_Range_Array_Attribute (Short) - -- Iir_Kind_Left_Array_Attribute (Short) - -- Iir_Kind_Right_Array_Attribute (Short) - -- Iir_Kind_High_Array_Attribute (Short) - -- Iir_Kind_Low_Array_Attribute (Short) - -- Iir_Kind_Ascending_Array_Attribute (Short) - -- Iir_Kind_Length_Array_Attribute (Short) - -- - -- Get/Set_Prefix (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Index_Subtype (Field2) - -- - -- Get/Set_Parameter (Field4) - -- - -- Get/Set_Base_Name (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - -- Iir_Kind_Stable_Attribute (Short) - -- Iir_Kind_Delayed_Attribute (Short) - -- Iir_Kind_Quiet_Attribute (Short) - -- Iir_Kind_Transaction_Attribute (Short) - -- (Iir_Kinds_Signal_Attribute) - -- - -- Get/Set_Prefix (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Chain (Field2) - -- - -- Not used by Iir_Kind_Transaction_Attribute - -- Get/Set_Parameter (Field4) - -- - -- Get/Set_Base_Name (Field5) - -- - -- Get/Set_Has_Active_Flag (Flag2) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - -- Iir_Kind_Event_Attribute (Short) - -- Iir_Kind_Last_Event_Attribute (Short) - -- Iir_Kind_Last_Value_Attribute (Short) - -- Iir_Kind_Active_Attribute (Short) - -- Iir_Kind_Last_Active_Attribute (Short) - -- Iir_Kind_Driving_Attribute (Short) - -- Iir_Kind_Driving_Value_Attribute (Short) - -- - -- Get/Set_Prefix (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - -- Iir_Kind_Pos_Attribute (Short) - -- Iir_Kind_Val_Attribute (Short) - -- Iir_Kind_Succ_Attribute (Short) - -- Iir_Kind_Pred_Attribute (Short) - -- Iir_Kind_Leftof_Attribute (Short) - -- Iir_Kind_Rightof_Attribute (Short) - -- - -- Get/Set_Prefix (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Parameter (Field4) - -- - -- Get/Set_Base_Name (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - -- Iir_Kind_Image_Attribute (Short) - -- Iir_Kind_Value_Attribute (Short) - -- - -- Get/Set_Prefix (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Get/Set_Parameter (Field4) - -- - -- Get/Set_Base_Name (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - -- Iir_Kind_Simple_Name_Attribute (Short) - -- Iir_Kind_Instance_Name_Attribute (Short) - -- Iir_Kind_Path_Name_Attribute (Short) - -- - -- Get/Set_Prefix (Field0) - -- - -- Get/Set_Type (Field1) - -- - -- Only for Iir_Kind_Simple_Name_Attribute: - -- Get/Set_Simple_Name_Identifier (Field3) - -- - -- Only for Iir_Kind_Simple_Name_Attribute: - -- Get/Set_Simple_Name_Subtype (Field4) - -- - -- Get/Set_Base_Name (Field5) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Name_Staticness (State2) - - -- Iir_Kind_Behavior_Attribute (Short) - -- Iir_Kind_Structure_Attribute (Short) - -- FIXME: to describe (Short) - - -- Iir_Kind_Error (Short) - -- Can be used instead of an expression or a type. - -- Get/Set_Type (Field1) - -- - -- Get/Set_Error_Origin (Field2) - -- - -- Get/Set_Type_Declarator (Field3) - -- - -- Get/Set_Base_Type (Field4) - -- - -- Get/Set_Expr_Staticness (State1) - -- - -- Get/Set_Type_Staticness (Alias State1) - -- - -- Get/Set_Resolved_Flag (Flag1) - -- - -- Get/Set_Signal_Type_Flag (Flag2) - -- - -- Get/Set_Has_Signal_Flag (Flag3) - - -- Iir_Kind_Unused (Short) - - -- End of Iir_Kind. - - - type Iir_Kind is - ( - Iir_Kind_Unused, - Iir_Kind_Error, - - Iir_Kind_Design_File, - Iir_Kind_Design_Unit, - Iir_Kind_Library_Clause, - Iir_Kind_Use_Clause, - - -- Literals. - Iir_Kind_Integer_Literal, - Iir_Kind_Floating_Point_Literal, - Iir_Kind_Null_Literal, - Iir_Kind_String_Literal, - Iir_Kind_Physical_Int_Literal, - Iir_Kind_Physical_Fp_Literal, - Iir_Kind_Bit_String_Literal, - Iir_Kind_Simple_Aggregate, - Iir_Kind_Overflow_Literal, - - -- Tuple, - Iir_Kind_Waveform_Element, - Iir_Kind_Conditional_Waveform, - Iir_Kind_Association_Element_By_Expression, - Iir_Kind_Association_Element_By_Individual, - Iir_Kind_Association_Element_Open, - Iir_Kind_Association_Element_Package, - Iir_Kind_Choice_By_Others, - Iir_Kind_Choice_By_Expression, - Iir_Kind_Choice_By_Range, - Iir_Kind_Choice_By_None, - Iir_Kind_Choice_By_Name, - Iir_Kind_Entity_Aspect_Entity, - Iir_Kind_Entity_Aspect_Configuration, - Iir_Kind_Entity_Aspect_Open, - Iir_Kind_Block_Configuration, - Iir_Kind_Block_Header, - Iir_Kind_Component_Configuration, - Iir_Kind_Binding_Indication, - Iir_Kind_Entity_Class, - Iir_Kind_Attribute_Value, - Iir_Kind_Signature, - Iir_Kind_Aggregate_Info, - Iir_Kind_Procedure_Call, - Iir_Kind_Record_Element_Constraint, - Iir_Kind_Array_Element_Resolution, - Iir_Kind_Record_Resolution, - Iir_Kind_Record_Element_Resolution, - - Iir_Kind_Attribute_Specification, - Iir_Kind_Disconnection_Specification, - Iir_Kind_Configuration_Specification, - - -- Type definitions. - -- iir_kinds_type_and_subtype_definition - -- kinds: disc: discrete, st: subtype. - Iir_Kind_Access_Type_Definition, - Iir_Kind_Incomplete_Type_Definition, - Iir_Kind_File_Type_Definition, - Iir_Kind_Protected_Type_Declaration, - Iir_Kind_Record_Type_Definition, -- composite - Iir_Kind_Array_Type_Definition, -- composite, array - Iir_Kind_Array_Subtype_Definition, -- composite, array, st - Iir_Kind_Record_Subtype_Definition, -- composite, st - Iir_Kind_Access_Subtype_Definition, -- st - Iir_Kind_Physical_Subtype_Definition, -- scalar, st, rng - Iir_Kind_Floating_Subtype_Definition, -- scalar, st, rng - Iir_Kind_Integer_Subtype_Definition, -- scalar, disc, st, rng - Iir_Kind_Enumeration_Subtype_Definition, -- scalar, disc, st, rng - Iir_Kind_Enumeration_Type_Definition, -- scalar, disc, rng - Iir_Kind_Integer_Type_Definition, -- scalar, disc - Iir_Kind_Floating_Type_Definition, -- scalar - Iir_Kind_Physical_Type_Definition, -- scalar - Iir_Kind_Range_Expression, - Iir_Kind_Protected_Type_Body, - Iir_Kind_Subtype_Definition, -- temporary (must not appear after sem). - - -- Nature definition - Iir_Kind_Scalar_Nature_Definition, - - -- Lists. - Iir_Kind_Overload_List, -- used internally by sem_expr. - - -- Declarations. - Iir_Kind_Type_Declaration, - Iir_Kind_Anonymous_Type_Declaration, - Iir_Kind_Subtype_Declaration, - Iir_Kind_Nature_Declaration, - Iir_Kind_Subnature_Declaration, - Iir_Kind_Package_Declaration, - Iir_Kind_Package_Instantiation_Declaration, - Iir_Kind_Package_Body, - Iir_Kind_Configuration_Declaration, - Iir_Kind_Entity_Declaration, - Iir_Kind_Architecture_Body, - Iir_Kind_Package_Header, - Iir_Kind_Unit_Declaration, - Iir_Kind_Library_Declaration, - Iir_Kind_Component_Declaration, - Iir_Kind_Attribute_Declaration, - Iir_Kind_Group_Template_Declaration, - Iir_Kind_Group_Declaration, - Iir_Kind_Element_Declaration, - Iir_Kind_Non_Object_Alias_Declaration, - - Iir_Kind_Psl_Declaration, - Iir_Kind_Terminal_Declaration, - Iir_Kind_Free_Quantity_Declaration, - Iir_Kind_Across_Quantity_Declaration, - Iir_Kind_Through_Quantity_Declaration, - - Iir_Kind_Enumeration_Literal, - Iir_Kind_Function_Declaration, -- Subprg, Func - Iir_Kind_Implicit_Function_Declaration, -- Subprg, Func, Imp_Subprg - Iir_Kind_Implicit_Procedure_Declaration, -- Subprg, Proc, Imp_Subprg - Iir_Kind_Procedure_Declaration, -- Subprg, Proc - Iir_Kind_Function_Body, - Iir_Kind_Procedure_Body, - - Iir_Kind_Object_Alias_Declaration, -- object - Iir_Kind_File_Declaration, -- object - Iir_Kind_Guard_Signal_Declaration, -- object - Iir_Kind_Signal_Declaration, -- object - Iir_Kind_Variable_Declaration, -- object - Iir_Kind_Constant_Declaration, -- object - Iir_Kind_Iterator_Declaration, -- object - Iir_Kind_Interface_Constant_Declaration, -- object, interface - Iir_Kind_Interface_Variable_Declaration, -- object, interface - Iir_Kind_Interface_Signal_Declaration, -- object, interface - Iir_Kind_Interface_File_Declaration, -- object, interface - Iir_Kind_Interface_Package_Declaration, - - -- Expressions. - Iir_Kind_Identity_Operator, - Iir_Kind_Negation_Operator, - Iir_Kind_Absolute_Operator, - Iir_Kind_Not_Operator, - Iir_Kind_Condition_Operator, - Iir_Kind_Reduction_And_Operator, - Iir_Kind_Reduction_Or_Operator, - Iir_Kind_Reduction_Nand_Operator, - Iir_Kind_Reduction_Nor_Operator, - Iir_Kind_Reduction_Xor_Operator, - Iir_Kind_Reduction_Xnor_Operator, - Iir_Kind_And_Operator, - Iir_Kind_Or_Operator, - Iir_Kind_Nand_Operator, - Iir_Kind_Nor_Operator, - Iir_Kind_Xor_Operator, - Iir_Kind_Xnor_Operator, - Iir_Kind_Equality_Operator, - Iir_Kind_Inequality_Operator, - Iir_Kind_Less_Than_Operator, - Iir_Kind_Less_Than_Or_Equal_Operator, - Iir_Kind_Greater_Than_Operator, - Iir_Kind_Greater_Than_Or_Equal_Operator, - Iir_Kind_Match_Equality_Operator, - Iir_Kind_Match_Inequality_Operator, - Iir_Kind_Match_Less_Than_Operator, - Iir_Kind_Match_Less_Than_Or_Equal_Operator, - Iir_Kind_Match_Greater_Than_Operator, - Iir_Kind_Match_Greater_Than_Or_Equal_Operator, - Iir_Kind_Sll_Operator, - Iir_Kind_Sla_Operator, - Iir_Kind_Srl_Operator, - Iir_Kind_Sra_Operator, - Iir_Kind_Rol_Operator, - Iir_Kind_Ror_Operator, - Iir_Kind_Addition_Operator, - Iir_Kind_Substraction_Operator, - Iir_Kind_Concatenation_Operator, - Iir_Kind_Multiplication_Operator, - Iir_Kind_Division_Operator, - Iir_Kind_Modulus_Operator, - Iir_Kind_Remainder_Operator, - Iir_Kind_Exponentiation_Operator, - Iir_Kind_Function_Call, - Iir_Kind_Aggregate, - Iir_Kind_Parenthesis_Expression, - Iir_Kind_Qualified_Expression, - Iir_Kind_Type_Conversion, - Iir_Kind_Allocator_By_Expression, - Iir_Kind_Allocator_By_Subtype, - Iir_Kind_Selected_Element, - Iir_Kind_Dereference, - Iir_Kind_Implicit_Dereference, - Iir_Kind_Slice_Name, - Iir_Kind_Indexed_Name, - Iir_Kind_Psl_Expression, - - -- Concurrent statements. - Iir_Kind_Sensitized_Process_Statement, - Iir_Kind_Process_Statement, - Iir_Kind_Concurrent_Conditional_Signal_Assignment, - Iir_Kind_Concurrent_Selected_Signal_Assignment, - Iir_Kind_Concurrent_Assertion_Statement, - Iir_Kind_Psl_Default_Clock, - Iir_Kind_Psl_Assert_Statement, - Iir_Kind_Psl_Cover_Statement, - Iir_Kind_Concurrent_Procedure_Call_Statement, - Iir_Kind_Block_Statement, - Iir_Kind_Generate_Statement, - Iir_Kind_Component_Instantiation_Statement, - - Iir_Kind_Simple_Simultaneous_Statement, - - -- Iir_Kind_Sequential_Statement - Iir_Kind_Signal_Assignment_Statement, - Iir_Kind_Null_Statement, - Iir_Kind_Assertion_Statement, - Iir_Kind_Report_Statement, - Iir_Kind_Wait_Statement, - Iir_Kind_Variable_Assignment_Statement, - Iir_Kind_Return_Statement, - Iir_Kind_For_Loop_Statement, - Iir_Kind_While_Loop_Statement, - Iir_Kind_Next_Statement, - Iir_Kind_Exit_Statement, - Iir_Kind_Case_Statement, - Iir_Kind_Procedure_Call_Statement, - Iir_Kind_If_Statement, - Iir_Kind_Elsif, - - -- Names - Iir_Kind_Character_Literal, -- denoting_name - Iir_Kind_Simple_Name, -- denoting_name - Iir_Kind_Selected_Name, -- denoting_name - Iir_Kind_Operator_Symbol, -- denoting_name - - Iir_Kind_Selected_By_All_Name, - Iir_Kind_Parenthesis_Name, - - -- Attributes - Iir_Kind_Base_Attribute, - Iir_Kind_Left_Type_Attribute, -- type_attribute - Iir_Kind_Right_Type_Attribute, -- type_attribute - Iir_Kind_High_Type_Attribute, -- type_attribute - Iir_Kind_Low_Type_Attribute, -- type_attribute - Iir_Kind_Ascending_Type_Attribute, -- type_attribute - Iir_Kind_Image_Attribute, - Iir_Kind_Value_Attribute, - Iir_Kind_Pos_Attribute, -- scalar_type_attribute - Iir_Kind_Val_Attribute, -- scalar_type_attribute - Iir_Kind_Succ_Attribute, -- scalar_type_attribute - Iir_Kind_Pred_Attribute, -- scalar_type_attribute - Iir_Kind_Leftof_Attribute, -- scalar_type_attribute - Iir_Kind_Rightof_Attribute, -- scalar_type_attribute - Iir_Kind_Delayed_Attribute, -- signal_attribute - Iir_Kind_Stable_Attribute, -- signal_attribute - Iir_Kind_Quiet_Attribute, -- signal_attribute - Iir_Kind_Transaction_Attribute, -- signal_attribute - Iir_Kind_Event_Attribute, -- signal_value_attribute - Iir_Kind_Active_Attribute, -- signal_value_attribute - Iir_Kind_Last_Event_Attribute, -- signal_value_attribute - Iir_Kind_Last_Active_Attribute, -- signal_value_attribute - Iir_Kind_Last_Value_Attribute, -- signal_value_attribute - Iir_Kind_Driving_Attribute, -- signal_value_attribute - Iir_Kind_Driving_Value_Attribute, -- signal_value_attribute - Iir_Kind_Behavior_Attribute, - Iir_Kind_Structure_Attribute, - Iir_Kind_Simple_Name_Attribute, - Iir_Kind_Instance_Name_Attribute, - Iir_Kind_Path_Name_Attribute, - Iir_Kind_Left_Array_Attribute, -- array_attribute - Iir_Kind_Right_Array_Attribute, -- array_attribute - Iir_Kind_High_Array_Attribute, -- array_attribute - Iir_Kind_Low_Array_Attribute, -- array_attribute - Iir_Kind_Length_Array_Attribute, -- array_attribute - Iir_Kind_Ascending_Array_Attribute, -- array_attribute - Iir_Kind_Range_Array_Attribute, -- array_attribute - Iir_Kind_Reverse_Range_Array_Attribute, -- array_attribute - - Iir_Kind_Attribute_Name - ); - - type Iir_Signal_Kind is - ( - Iir_No_Signal_Kind, - Iir_Register_Kind, - Iir_Bus_Kind - ); - - -- If the order of elements in IIR_MODE is modified, also modify the - -- order in GRT (types and rtis). - type Iir_Mode is - ( - Iir_Unknown_Mode, - Iir_Linkage_Mode, - Iir_Buffer_Mode, - Iir_Out_Mode, - Iir_Inout_Mode, - Iir_In_Mode - ); - - subtype Iir_In_Modes is Iir_Mode range Iir_Inout_Mode .. Iir_In_Mode; - subtype Iir_Out_Modes is Iir_Mode range Iir_Out_Mode .. Iir_Inout_Mode; - - type Iir_Delay_Mechanism is (Iir_Inertial_Delay, Iir_Transport_Delay); - - type Iir_Direction is (Iir_To, Iir_Downto); - - -- Iir_Lexical_Layout_type describe the lexical token used to describe - -- an interface declaration. This has no semantics meaning, but it is - -- necessary to keep how lexically an interface was declared due to - -- LRM93 2.7 (conformance rules). - -- To keep this simple, the layout is stored as a bit-string. - -- Fields are: - -- Has_type: set if the interface is the last of a list. - -- has_mode: set if mode is explicit - -- has_class: set if class (constant, signal, variable or file) is explicit - -- - -- Exemple: - -- procedure P ( A, B: integer; - -- constant C: in bit; - -- D: inout bit; - -- variable E: bit; - -- F, G: in bit; - -- constant H, I: bit; - -- constant J, K: in bit); - -- A: - -- B: has_type - -- C, has_class, has_mode, has_type - -- D: has_mode, has_type - -- E, has_class, has_type - -- F: has_mode - -- G: has_mode, has_type - -- H: has_class - -- I: has_class, has_type - -- J: has_class, has_mode - -- K: has_class, has_mode, has_type - type Iir_Lexical_Layout_Type is mod 2 ** 3; - Iir_Lexical_Has_Mode : constant Iir_Lexical_Layout_Type := 2 ** 0; - Iir_Lexical_Has_Class : constant Iir_Lexical_Layout_Type := 2 ** 1; - Iir_Lexical_Has_Type : constant Iir_Lexical_Layout_Type := 2 ** 2; - - -- List of predefined operators and functions. - type Iir_Predefined_Functions is - ( - Iir_Predefined_Error, - - -- Predefined operators for BOOLEAN type. - Iir_Predefined_Boolean_And, - Iir_Predefined_Boolean_Or, - Iir_Predefined_Boolean_Nand, - Iir_Predefined_Boolean_Nor, - Iir_Predefined_Boolean_Xor, - Iir_Predefined_Boolean_Xnor, - Iir_Predefined_Boolean_Not, - - Iir_Predefined_Boolean_Rising_Edge, - Iir_Predefined_Boolean_Falling_Edge, - - -- Predefined operators for any enumeration type. - Iir_Predefined_Enum_Equality, - Iir_Predefined_Enum_Inequality, - Iir_Predefined_Enum_Less, - Iir_Predefined_Enum_Less_Equal, - Iir_Predefined_Enum_Greater, - Iir_Predefined_Enum_Greater_Equal, - - Iir_Predefined_Enum_Minimum, - Iir_Predefined_Enum_Maximum, - Iir_Predefined_Enum_To_String, - - -- Predefined operators for BIT type. - Iir_Predefined_Bit_And, - Iir_Predefined_Bit_Or, - Iir_Predefined_Bit_Nand, - Iir_Predefined_Bit_Nor, - Iir_Predefined_Bit_Xor, - Iir_Predefined_Bit_Xnor, - Iir_Predefined_Bit_Not, - - Iir_Predefined_Bit_Match_Equality, - Iir_Predefined_Bit_Match_Inequality, - Iir_Predefined_Bit_Match_Less, - Iir_Predefined_Bit_Match_Less_Equal, - Iir_Predefined_Bit_Match_Greater, - Iir_Predefined_Bit_Match_Greater_Equal, - - Iir_Predefined_Bit_Condition, - - Iir_Predefined_Bit_Rising_Edge, - Iir_Predefined_Bit_Falling_Edge, - - -- Predefined operators for any integer type. - Iir_Predefined_Integer_Equality, - Iir_Predefined_Integer_Inequality, - Iir_Predefined_Integer_Less, - Iir_Predefined_Integer_Less_Equal, - Iir_Predefined_Integer_Greater, - Iir_Predefined_Integer_Greater_Equal, - - Iir_Predefined_Integer_Identity, - Iir_Predefined_Integer_Negation, - Iir_Predefined_Integer_Absolute, - - Iir_Predefined_Integer_Plus, - Iir_Predefined_Integer_Minus, - Iir_Predefined_Integer_Mul, - Iir_Predefined_Integer_Div, - Iir_Predefined_Integer_Mod, - Iir_Predefined_Integer_Rem, - - Iir_Predefined_Integer_Exp, - - Iir_Predefined_Integer_Minimum, - Iir_Predefined_Integer_Maximum, - Iir_Predefined_Integer_To_String, - - -- Predefined operators for any floating type. - Iir_Predefined_Floating_Equality, - Iir_Predefined_Floating_Inequality, - Iir_Predefined_Floating_Less, - Iir_Predefined_Floating_Less_Equal, - Iir_Predefined_Floating_Greater, - Iir_Predefined_Floating_Greater_Equal, - - Iir_Predefined_Floating_Identity, - Iir_Predefined_Floating_Negation, - Iir_Predefined_Floating_Absolute, - - Iir_Predefined_Floating_Plus, - Iir_Predefined_Floating_Minus, - Iir_Predefined_Floating_Mul, - Iir_Predefined_Floating_Div, - - Iir_Predefined_Floating_Exp, - - Iir_Predefined_Floating_Minimum, - Iir_Predefined_Floating_Maximum, - Iir_Predefined_Floating_To_String, - - Iir_Predefined_Real_To_String_Digits, - Iir_Predefined_Real_To_String_Format, - - -- Predefined operator for universal types. - Iir_Predefined_Universal_R_I_Mul, - Iir_Predefined_Universal_I_R_Mul, - Iir_Predefined_Universal_R_I_Div, - - -- Predefined operators for physical types. - Iir_Predefined_Physical_Equality, - Iir_Predefined_Physical_Inequality, - Iir_Predefined_Physical_Less, - Iir_Predefined_Physical_Less_Equal, - Iir_Predefined_Physical_Greater, - Iir_Predefined_Physical_Greater_Equal, - - Iir_Predefined_Physical_Identity, - Iir_Predefined_Physical_Negation, - Iir_Predefined_Physical_Absolute, - - Iir_Predefined_Physical_Plus, - Iir_Predefined_Physical_Minus, - - Iir_Predefined_Physical_Integer_Mul, - Iir_Predefined_Physical_Real_Mul, - Iir_Predefined_Integer_Physical_Mul, - Iir_Predefined_Real_Physical_Mul, - Iir_Predefined_Physical_Integer_Div, - Iir_Predefined_Physical_Real_Div, - Iir_Predefined_Physical_Physical_Div, - - Iir_Predefined_Physical_Minimum, - Iir_Predefined_Physical_Maximum, - Iir_Predefined_Physical_To_String, - - Iir_Predefined_Time_To_String_Unit, - - -- Predefined operators for access. - Iir_Predefined_Access_Equality, - Iir_Predefined_Access_Inequality, - - -- Predefined operators for record. - Iir_Predefined_Record_Equality, - Iir_Predefined_Record_Inequality, - - -- Predefined operators for array. - Iir_Predefined_Array_Equality, - Iir_Predefined_Array_Inequality, - Iir_Predefined_Array_Less, - Iir_Predefined_Array_Less_Equal, - Iir_Predefined_Array_Greater, - Iir_Predefined_Array_Greater_Equal, - - Iir_Predefined_Array_Array_Concat, - Iir_Predefined_Array_Element_Concat, - Iir_Predefined_Element_Array_Concat, - Iir_Predefined_Element_Element_Concat, - - Iir_Predefined_Array_Minimum, - Iir_Predefined_Array_Maximum, - Iir_Predefined_Vector_Minimum, - Iir_Predefined_Vector_Maximum, - - -- Predefined shift operators. - Iir_Predefined_Array_Sll, - Iir_Predefined_Array_Srl, - Iir_Predefined_Array_Sla, - Iir_Predefined_Array_Sra, - Iir_Predefined_Array_Rol, - Iir_Predefined_Array_Ror, - - -- Predefined operators for one dimensional array. - -- For bit and boolean type, the operations are the same. For a neutral - -- noun, we use TF (for True/False) instead of Bit, Boolean or Logic. - Iir_Predefined_TF_Array_And, - Iir_Predefined_TF_Array_Or, - Iir_Predefined_TF_Array_Nand, - Iir_Predefined_TF_Array_Nor, - Iir_Predefined_TF_Array_Xor, - Iir_Predefined_TF_Array_Xnor, - Iir_Predefined_TF_Array_Not, - - Iir_Predefined_TF_Reduction_And, - Iir_Predefined_TF_Reduction_Or, - Iir_Predefined_TF_Reduction_Nand, - Iir_Predefined_TF_Reduction_Nor, - Iir_Predefined_TF_Reduction_Xor, - Iir_Predefined_TF_Reduction_Xnor, - Iir_Predefined_TF_Reduction_Not, - - Iir_Predefined_TF_Array_Element_And, - Iir_Predefined_TF_Element_Array_And, - Iir_Predefined_TF_Array_Element_Or, - Iir_Predefined_TF_Element_Array_Or, - Iir_Predefined_TF_Array_Element_Nand, - Iir_Predefined_TF_Element_Array_Nand, - Iir_Predefined_TF_Array_Element_Nor, - Iir_Predefined_TF_Element_Array_Nor, - Iir_Predefined_TF_Array_Element_Xor, - Iir_Predefined_TF_Element_Array_Xor, - Iir_Predefined_TF_Array_Element_Xnor, - Iir_Predefined_TF_Element_Array_Xnor, - - Iir_Predefined_Bit_Array_Match_Equality, - Iir_Predefined_Bit_Array_Match_Inequality, - - -- Predefined attribute functions. - Iir_Predefined_Attribute_Image, - Iir_Predefined_Attribute_Value, - Iir_Predefined_Attribute_Pos, - Iir_Predefined_Attribute_Val, - Iir_Predefined_Attribute_Succ, - Iir_Predefined_Attribute_Pred, - Iir_Predefined_Attribute_Leftof, - Iir_Predefined_Attribute_Rightof, - Iir_Predefined_Attribute_Left, - Iir_Predefined_Attribute_Right, - Iir_Predefined_Attribute_Event, - Iir_Predefined_Attribute_Active, - Iir_Predefined_Attribute_Last_Event, - Iir_Predefined_Attribute_Last_Active, - Iir_Predefined_Attribute_Last_Value, - Iir_Predefined_Attribute_Driving, - Iir_Predefined_Attribute_Driving_Value, - - -- Access procedure - Iir_Predefined_Deallocate, - - -- file function / procedures. - Iir_Predefined_File_Open, - Iir_Predefined_File_Open_Status, - Iir_Predefined_File_Close, - Iir_Predefined_Read, - Iir_Predefined_Read_Length, - Iir_Predefined_Flush, - Iir_Predefined_Write, - Iir_Predefined_Endfile, - - -- To_String - Iir_Predefined_Array_Char_To_String, - Iir_Predefined_Bit_Vector_To_Ostring, - Iir_Predefined_Bit_Vector_To_Hstring, - - -- IEEE.Std_Logic_1164.Std_Ulogic - Iir_Predefined_Std_Ulogic_Match_Equality, - Iir_Predefined_Std_Ulogic_Match_Inequality, - Iir_Predefined_Std_Ulogic_Match_Less, - Iir_Predefined_Std_Ulogic_Match_Less_Equal, - Iir_Predefined_Std_Ulogic_Match_Greater, - Iir_Predefined_Std_Ulogic_Match_Greater_Equal, - - Iir_Predefined_Std_Ulogic_Array_Match_Equality, - Iir_Predefined_Std_Ulogic_Array_Match_Inequality, - - -- Predefined function. - Iir_Predefined_Now_Function - ); - - -- Return TRUE iff FUNC is a short-cut predefined function. - function Iir_Predefined_Shortcut_P (Func : Iir_Predefined_Functions) - return Boolean; - - subtype Iir_Predefined_Pure_Functions is Iir_Predefined_Functions range - Iir_Predefined_Boolean_And .. Iir_Predefined_Attribute_Driving_Value; - - subtype Iir_Predefined_Dyadic_TF_Array_Functions - is Iir_Predefined_Functions range - Iir_Predefined_TF_Array_And .. - --Iir_Predefined_TF_Array_Or - --Iir_Predefined_TF_Array_Nand - --Iir_Predefined_TF_Array_Nor - --Iir_Predefined_TF_Array_Xor - Iir_Predefined_TF_Array_Xnor; - - subtype Iir_Predefined_Shift_Functions is Iir_Predefined_Functions range - Iir_Predefined_Array_Sll .. - --Iir_Predefined_Array_Srl - --Iir_Predefined_Array_Sla - --Iir_Predefined_Array_Sra - --Iir_Predefined_Array_Rol - Iir_Predefined_Array_Ror; - - subtype Iir_Predefined_Concat_Functions is Iir_Predefined_Functions range - Iir_Predefined_Array_Array_Concat .. - --Iir_Predefined_Array_Element_Concat - --Iir_Predefined_Element_Array_Concat - Iir_Predefined_Element_Element_Concat; - - subtype Iir_Predefined_Std_Ulogic_Match_Ordering_Functions is - Iir_Predefined_Functions range - Iir_Predefined_Std_Ulogic_Match_Less .. - --Iir_Predefined_Std_Ulogic_Match_Less_Equal - --Iir_Predefined_Std_Ulogic_Match_Greater - Iir_Predefined_Std_Ulogic_Match_Greater_Equal; - - -- Staticness as defined by LRM93 §6.1 and §7.4 - type Iir_Staticness is (Unknown, None, Globally, Locally); - - -- Staticness as defined by LRM93 §6.1 and §7.4 - function Min (L,R: Iir_Staticness) return Iir_Staticness renames - Iir_Staticness'Min; - - -- Purity state of a procedure. - -- PURE means the procedure is pure. - -- IMPURE means the procedure is impure: it references a file object or - -- a signal or a variable declared outside a subprogram, or it calls an - -- impure subprogram. - -- MAYBE_IMPURE means the procedure references a signal or a variable - -- declared in a subprogram. The relative position of a parent has to - -- be considered. The list of callees must not be checked. - -- UNKNOWN is like MAYBE_IMPURE, but the subprogram has a list of callees - -- whose purity is not yet known. As a consequence, a direct or - -- indirect call to such a procedure cannot be proved to be allowed - -- in a pure function. - -- Note: UNKNOWN is the default state. At any impure call, the state is - -- set to IMPURE. Only at the end of body analysis and only if the - -- callee list is empty, the state can be set either to MAYBE_IMPURE or - -- PURE. - type Iir_Pure_State is (Unknown, Pure, Maybe_Impure, Impure); - - -- State of subprograms for validity of use in all-sensitized process. - -- INVALID_SIGNAL means that the subprogram is in a package and - -- reads a signal or that the subprogram calls (indirectly) such - -- a subprogram. In this case, the subprogram cannot be called from - -- an all-sensitized process. - -- READ_SIGNAL means that the subprogram reads a signal and is defined - -- in an entity or an architecture or that the subprogram calls - -- (indirectly) such a subprogram. In this case, the subprogram can - -- be called from an all-sensitized process and the reference will be - -- part of the sensitivity list. - -- NO_SIGNAL means that the subprogram doesn't read any signal and don't - -- call such a subprogram. The subprogram can be called from an - -- all-sensitized process but there is no need to track this call. - -- UNKNOWN means that the state is not yet defined. - type Iir_All_Sensitized is - (Unknown, No_Signal, Read_Signal, Invalid_Signal); - - -- Constraint state of a type. - -- See LRM08 5.1 for definition. - type Iir_Constraint is - (Unconstrained, Partially_Constrained, Fully_Constrained); - - -- The kind of an inteface list. - type Interface_Kind_Type is (Generic_Interface_List, - Port_Interface_List, - Procedure_Parameter_Interface_List, - Function_Parameter_Interface_List); - subtype Parameter_Interface_List is Interface_Kind_Type range - Procedure_Parameter_Interface_List .. - Function_Parameter_Interface_List; - - --------------- - -- subranges -- - --------------- - -- These subtypes are used for ranges, for `case' statments or for the `in' - -- operator. - - -- In order to be correctly parsed by check_iir, the declaration must - -- follow these rules: - -- * the first line must be "subtype Iir_Kinds_NAME is Iir_Kind_range" - -- * the second line must be the lowest bound of the range, followed by ".. - -- * comments line - -- * the last line must be the highest bound of the range, followed by ";" - --- subtype Iir_Kinds_List is Iir_Kind range --- Iir_Kind_List .. --- Iir_Kind_Callees_List; - - subtype Iir_Kinds_Library_Unit_Declaration is Iir_Kind range - Iir_Kind_Package_Declaration .. - --Iir_Kind_Package_Instantiation_Declaration - --Iir_Kind_Package_Body - --Iir_Kind_Configuration_Declaration - --Iir_Kind_Entity_Declaration - Iir_Kind_Architecture_Body; - - subtype Iir_Kinds_Package_Declaration is Iir_Kind range - Iir_Kind_Package_Declaration .. - Iir_Kind_Package_Instantiation_Declaration; - - -- Note: does not include iir_kind_enumeration_literal since it is - -- considered as a declaration. - subtype Iir_Kinds_Literal is Iir_Kind range - Iir_Kind_Integer_Literal .. - --Iir_Kind_Floating_Point_Literal - --Iir_Kind_Null_Literal - --Iir_Kind_String_Literal - --Iir_Kind_Physical_Int_Literal - --Iir_Kind_Physical_Fp_Literal - Iir_Kind_Bit_String_Literal; - - subtype Iir_Kinds_Array_Type_Definition is Iir_Kind range - Iir_Kind_Array_Type_Definition .. - Iir_Kind_Array_Subtype_Definition; - - subtype Iir_Kinds_Type_And_Subtype_Definition is Iir_Kind range - Iir_Kind_Access_Type_Definition .. - --Iir_Kind_Incomplete_Type_Definition - --Iir_Kind_File_Type_Definition - --Iir_Kind_Protected_Type_Declaration - --Iir_Kind_Record_Type_Definition - --Iir_Kind_Array_Type_Definition - --Iir_Kind_Array_Subtype_Definition - --Iir_Kind_Record_Subtype_Definition - --Iir_Kind_Access_Subtype_Definition - --Iir_Kind_Physical_Subtype_Definition - --Iir_Kind_Floating_Subtype_Definition - --Iir_Kind_Integer_Subtype_Definition - --Iir_Kind_Enumeration_Subtype_Definition - --Iir_Kind_Enumeration_Type_Definition - --Iir_Kind_Integer_Type_Definition - --Iir_Kind_Floating_Type_Definition - Iir_Kind_Physical_Type_Definition; - - subtype Iir_Kinds_Subtype_Definition is Iir_Kind range - Iir_Kind_Array_Subtype_Definition .. - --Iir_Kind_Record_Subtype_Definition - --Iir_Kind_Access_Subtype_Definition - --Iir_Kind_Physical_Subtype_Definition - --Iir_Kind_Floating_Subtype_Definition - --Iir_Kind_Integer_Subtype_Definition - Iir_Kind_Enumeration_Subtype_Definition; - - subtype Iir_Kinds_Scalar_Subtype_Definition is Iir_Kind range - Iir_Kind_Physical_Subtype_Definition .. - --Iir_Kind_Floating_Subtype_Definition - --Iir_Kind_Integer_Subtype_Definition - Iir_Kind_Enumeration_Subtype_Definition; - - subtype Iir_Kinds_Scalar_Type_Definition is Iir_Kind range - Iir_Kind_Physical_Subtype_Definition .. - --Iir_Kind_Floating_Subtype_Definition - --Iir_Kind_Integer_Subtype_Definition - --Iir_Kind_Enumeration_Subtype_Definition - --Iir_Kind_Enumeration_Type_Definition - --Iir_Kind_Integer_Type_Definition - --Iir_Kind_Floating_Type_Definition - Iir_Kind_Physical_Type_Definition; - - subtype Iir_Kinds_Range_Type_Definition is Iir_Kind range - Iir_Kind_Physical_Subtype_Definition .. - --Iir_Kind_Floating_Subtype_Definition - --Iir_Kind_Integer_Subtype_Definition - --Iir_Kind_Enumeration_Subtype_Definition - Iir_Kind_Enumeration_Type_Definition; - - subtype Iir_Kinds_Discrete_Type_Definition is Iir_Kind range - Iir_Kind_Integer_Subtype_Definition .. - --Iir_Kind_Enumeration_Subtype_Definition - --Iir_Kind_Enumeration_Type_Definition - Iir_Kind_Integer_Type_Definition; - --- subtype Iir_Kinds_Discrete_Subtype_Definition is Iir_Kind range --- Iir_Kind_Integer_Subtype_Definition .. --- Iir_Kind_Enumeration_Subtype_Definition; - - subtype Iir_Kinds_Composite_Type_Definition is Iir_Kind range - Iir_Kind_Record_Type_Definition .. - --Iir_Kind_Array_Type_Definition - --Iir_Kind_Array_Subtype_Definition - Iir_Kind_Record_Subtype_Definition; - - subtype Iir_Kinds_Type_Declaration is Iir_Kind range - Iir_Kind_Type_Declaration .. - --Iir_Kind_Anonymous_Type_Declaration - Iir_Kind_Subtype_Declaration; - - subtype Iir_Kinds_Nonoverloadable_Declaration is Iir_Kind range - Iir_Kind_Type_Declaration .. - Iir_Kind_Element_Declaration; - - subtype Iir_Kinds_Monadic_Operator is Iir_Kind range - Iir_Kind_Identity_Operator .. - --Iir_Kind_Negation_Operator - --Iir_Kind_Absolute_Operator - --Iir_Kind_Not_Operator - --Iir_Kind_Condition_Operator - --Iir_Kind_Reduction_And_Operator - --Iir_Kind_Reduction_Or_Operator - --Iir_Kind_Reduction_Nand_Operator - --Iir_Kind_Reduction_Nor_Operator - --Iir_Kind_Reduction_Xor_Operator - Iir_Kind_Reduction_Xnor_Operator; - - subtype Iir_Kinds_Dyadic_Operator is Iir_Kind range - Iir_Kind_And_Operator .. - --Iir_Kind_Or_Operator - --Iir_Kind_Nand_Operator - --Iir_Kind_Nor_Operator - --Iir_Kind_Xor_Operator - --Iir_Kind_Xnor_Operator - --Iir_Kind_Equality_Operator - --Iir_Kind_Inequality_Operator - --Iir_Kind_Less_Than_Operator - --Iir_Kind_Less_Than_Or_Equal_Operator - --Iir_Kind_Greater_Than_Operator - --Iir_Kind_Greater_Than_Or_Equal_Operator - --Iir_Kind_Match_Equality_Operator - --Iir_Kind_Match_Inequality_Operator - --Iir_Kind_Match_Less_Than_Operator - --Iir_Kind_Match_Less_Than_Or_Equal_Operator - --Iir_Kind_Match_Greater_Than_Operator - --Iir_Kind_Match_Greater_Than_Or_Equal_Operator - --Iir_Kind_Sll_Operator - --Iir_Kind_Sla_Operator - --Iir_Kind_Srl_Operator - --Iir_Kind_Sra_Operator - --Iir_Kind_Rol_Operator - --Iir_Kind_Ror_Operator - --Iir_Kind_Addition_Operator - --Iir_Kind_Substraction_Operator - --Iir_Kind_Concatenation_Operator - --Iir_Kind_Multiplication_Operator - --Iir_Kind_Division_Operator - --Iir_Kind_Modulus_Operator - --Iir_Kind_Remainder_Operator - Iir_Kind_Exponentiation_Operator; - - subtype Iir_Kinds_Function_Declaration is Iir_Kind range - Iir_Kind_Function_Declaration .. - Iir_Kind_Implicit_Function_Declaration; - - subtype Iir_Kinds_Functions_And_Literals is Iir_Kind range - Iir_Kind_Enumeration_Literal .. - --Iir_Kind_Function_Declaration - Iir_Kind_Implicit_Function_Declaration; - - subtype Iir_Kinds_Procedure_Declaration is Iir_Kind range - Iir_Kind_Implicit_Procedure_Declaration .. - Iir_Kind_Procedure_Declaration; - - subtype Iir_Kinds_Subprogram_Declaration is Iir_Kind range - Iir_Kind_Function_Declaration .. - --Iir_Kind_Implicit_Function_Declaration - --Iir_Kind_Implicit_Procedure_Declaration - Iir_Kind_Procedure_Declaration; - - subtype Iir_Kinds_Implicit_Subprogram_Declaration is Iir_Kind range - Iir_Kind_Implicit_Function_Declaration .. - Iir_Kind_Implicit_Procedure_Declaration; - - subtype Iir_Kinds_Process_Statement is Iir_Kind range - Iir_Kind_Sensitized_Process_Statement .. - Iir_Kind_Process_Statement; - - subtype Iir_Kinds_Interface_Object_Declaration is Iir_Kind range - Iir_Kind_Interface_Constant_Declaration .. - --Iir_Kind_Interface_Variable_Declaration - --Iir_Kind_Interface_Signal_Declaration - Iir_Kind_Interface_File_Declaration; - - subtype Iir_Kinds_Object_Declaration is Iir_Kind range - Iir_Kind_Object_Alias_Declaration .. - --Iir_Kind_File_Declaration - --Iir_Kind_Guard_Signal_Declaration - --Iir_Kind_Signal_Declaration - --Iir_Kind_Variable_Declaration - --Iir_Kind_Constant_Declaration - --Iir_Kind_Iterator_Declaration - --Iir_Kind_Interface_Constant_Declaration - --Iir_Kind_Interface_Variable_Declaration - --Iir_Kind_Interface_Signal_Declaration - Iir_Kind_Interface_File_Declaration; - - subtype Iir_Kinds_Branch_Quantity_Declaration is Iir_Kind range - Iir_Kind_Across_Quantity_Declaration .. - Iir_Kind_Through_Quantity_Declaration; - - subtype Iir_Kinds_Quantity_Declaration is Iir_Kind range - Iir_Kind_Free_Quantity_Declaration .. - --Iir_Kind_Across_Quantity_Declaration - Iir_Kind_Through_Quantity_Declaration; - - subtype Iir_Kinds_Non_Alias_Object_Declaration is Iir_Kind range - Iir_Kind_File_Declaration .. - --Iir_Kind_Guard_Signal_Declaration - --Iir_Kind_Signal_Declaration - --Iir_Kind_Variable_Declaration - --Iir_Kind_Constant_Declaration - --Iir_Kind_Iterator_Declaration - --Iir_Kind_Interface_Constant_Declaration - --Iir_Kind_Interface_Variable_Declaration - --Iir_Kind_Interface_Signal_Declaration - Iir_Kind_Interface_File_Declaration; - - subtype Iir_Kinds_Association_Element is Iir_Kind range - Iir_Kind_Association_Element_By_Expression .. - --Iir_Kind_Association_Element_By_Individual - Iir_Kind_Association_Element_Open; - - subtype Iir_Kinds_Choice is Iir_Kind range - Iir_Kind_Choice_By_Others .. - --Iir_Kind_Choice_By_Expression - --Iir_Kind_Choice_By_Range - --Iir_Kind_Choice_By_None - Iir_Kind_Choice_By_Name; - - subtype Iir_Kinds_Denoting_Name is Iir_Kind range - Iir_Kind_Character_Literal .. - --Iir_Kind_Simple_Name - --Iir_Kind_Selected_Name - Iir_Kind_Operator_Symbol; - - subtype Iir_Kinds_Name is Iir_Kind range - Iir_Kind_Character_Literal .. - --Iir_Kind_Simple_Name - --Iir_Kind_Selected_Name - --Iir_Kind_Operator_Symbol - --Iir_Kind_Selected_By_All_Name - Iir_Kind_Parenthesis_Name; - - subtype Iir_Kinds_Dereference is Iir_Kind range - Iir_Kind_Dereference .. - Iir_Kind_Implicit_Dereference; - - -- Any attribute that is an expression. - subtype Iir_Kinds_Expression_Attribute is Iir_Kind range - Iir_Kind_Left_Type_Attribute .. - --Iir_Kind_Right_Type_Attribute - --Iir_Kind_High_Type_Attribute - --Iir_Kind_Low_Type_Attribute - --Iir_Kind_Ascending_Type_Attribute - --Iir_Kind_Image_Attribute - --Iir_Kind_Value_Attribute - --Iir_Kind_Pos_Attribute - --Iir_Kind_Val_Attribute - --Iir_Kind_Succ_Attribute - --Iir_Kind_Pred_Attribute - --Iir_Kind_Leftof_Attribute - --Iir_Kind_Rightof_Attribute - --Iir_Kind_Delayed_Attribute - --Iir_Kind_Stable_Attribute - --Iir_Kind_Quiet_Attribute - --Iir_Kind_Transaction_Attribute - --Iir_Kind_Event_Attribute - --Iir_Kind_Active_Attribute - --Iir_Kind_Last_Event_Attribute - --Iir_Kind_Last_Active_Attribute - --Iir_Kind_Last_Value_Attribute - --Iir_Kind_Driving_Attribute - --Iir_Kind_Driving_Value_Attribute - --Iir_Kind_Behavior_Attribute - --Iir_Kind_Structure_Attribute - --Iir_Kind_Simple_Name_Attribute - --Iir_Kind_Instance_Name_Attribute - --Iir_Kind_Path_Name_Attribute - --Iir_Kind_Left_Array_Attribute - --Iir_Kind_Right_Array_Attribute - --Iir_Kind_High_Array_Attribute - --Iir_Kind_Low_Array_Attribute - --Iir_Kind_Length_Array_Attribute - Iir_Kind_Ascending_Array_Attribute; - - -- All the attributes. - subtype Iir_Kinds_Attribute is Iir_Kind range - Iir_Kind_Base_Attribute .. - Iir_Kind_Reverse_Range_Array_Attribute; - - subtype Iir_Kinds_Type_Attribute is Iir_Kind range - Iir_Kind_Left_Type_Attribute .. - --Iir_Kind_Right_Type_Attribute - --Iir_Kind_High_Type_Attribute - --Iir_Kind_Low_Type_Attribute - Iir_Kind_Ascending_Type_Attribute; - - subtype Iir_Kinds_Scalar_Type_Attribute is Iir_Kind range - Iir_Kind_Pos_Attribute .. - --Iir_Kind_Val_Attribute - --Iir_Kind_Succ_Attribute - --Iir_Kind_Pred_Attribute - --Iir_Kind_Leftof_Attribute - Iir_Kind_Rightof_Attribute; - - subtype Iir_Kinds_Array_Attribute is Iir_Kind range - Iir_Kind_Left_Array_Attribute .. - --Iir_Kind_Right_Array_Attribute - --Iir_Kind_High_Array_Attribute - --Iir_Kind_Low_Array_Attribute - --Iir_Kind_Length_Array_Attribute - --Iir_Kind_Ascending_Array_Attribute - --Iir_Kind_Range_Array_Attribute - Iir_Kind_Reverse_Range_Array_Attribute; - - subtype Iir_Kinds_Signal_Attribute is Iir_Kind range - Iir_Kind_Delayed_Attribute .. - --Iir_Kind_Stable_Attribute - --Iir_Kind_Quiet_Attribute - Iir_Kind_Transaction_Attribute; - - subtype Iir_Kinds_Signal_Value_Attribute is Iir_Kind range - Iir_Kind_Event_Attribute .. - --Iir_Kind_Active_Attribute - --Iir_Kind_Last_Event_Attribute - --Iir_Kind_Last_Active_Attribute - --Iir_Kind_Last_Value_Attribute - --Iir_Kind_Driving_Attribute - Iir_Kind_Driving_Value_Attribute; - - subtype Iir_Kinds_Name_Attribute is Iir_Kind range - Iir_Kind_Simple_Name_Attribute .. - --Iir_Kind_Instance_Name_Attribute - Iir_Kind_Path_Name_Attribute; - - subtype Iir_Kinds_Concurrent_Statement is Iir_Kind range - Iir_Kind_Sensitized_Process_Statement .. - --Iir_Kind_Process_Statement - --Iir_Kind_Concurrent_Conditional_Signal_Assignment - --Iir_Kind_Concurrent_Selected_Signal_Assignment - --Iir_Kind_Concurrent_Assertion_Statement - --Iir_Kind_Psl_Default_Clock - --Iir_Kind_Psl_Assert_Statement - --Iir_Kind_Psl_Cover_Statement - --Iir_Kind_Concurrent_Procedure_Call_Statement - --Iir_Kind_Block_Statement - --Iir_Kind_Generate_Statement - Iir_Kind_Component_Instantiation_Statement; - - subtype Iir_Kinds_Concurrent_Signal_Assignment is Iir_Kind range - Iir_Kind_Concurrent_Conditional_Signal_Assignment .. - Iir_Kind_Concurrent_Selected_Signal_Assignment; - - subtype Iir_Kinds_Sequential_Statement is Iir_Kind range - Iir_Kind_Signal_Assignment_Statement .. - --Iir_Kind_Null_Statement - --Iir_Kind_Assertion_Statement - --Iir_Kind_Report_Statement - --Iir_Kind_Wait_Statement - --Iir_Kind_Variable_Assignment_Statement - --Iir_Kind_Return_Statement - --Iir_Kind_For_Loop_Statement - --Iir_Kind_While_Loop_Statement - --Iir_Kind_Next_Statement - --Iir_Kind_Exit_Statement - --Iir_Kind_Case_Statement - --Iir_Kind_Procedure_Call_Statement - Iir_Kind_If_Statement; - - subtype Iir_Kinds_Allocator is Iir_Kind range - Iir_Kind_Allocator_By_Expression .. - Iir_Kind_Allocator_By_Subtype; - - subtype Iir_Kinds_Clause is Iir_Kind range - Iir_Kind_Library_Clause .. - Iir_Kind_Use_Clause; - - subtype Iir_Kinds_Specification is Iir_Kind range - Iir_Kind_Attribute_Specification .. - --Iir_Kind_Disconnection_Specification - Iir_Kind_Configuration_Specification; - - subtype Iir_Kinds_Declaration is Iir_Kind range - Iir_Kind_Type_Declaration .. - --Iir_Kind_Anonymous_Type_Declaration - --Iir_Kind_Subtype_Declaration - --Iir_Kind_Nature_Declaration - --Iir_Kind_Subnature_Declaration - --Iir_Kind_Package_Declaration - --Iir_Kind_Package_Instantiation_Declaration - --Iir_Kind_Package_Body - --Iir_Kind_Configuration_Declaration - --Iir_Kind_Entity_Declaration - --Iir_Kind_Architecture_Body - --Iir_Kind_Package_Header - --Iir_Kind_Unit_Declaration - --Iir_Kind_Library_Declaration - --Iir_Kind_Component_Declaration - --Iir_Kind_Attribute_Declaration - --Iir_Kind_Group_Template_Declaration - --Iir_Kind_Group_Declaration - --Iir_Kind_Element_Declaration - --Iir_Kind_Non_Object_Alias_Declaration - --Iir_Kind_Psl_Declaration - --Iir_Kind_Terminal_Declaration - --Iir_Kind_Free_Quantity_Declaration - --Iir_Kind_Across_Quantity_Declaration - --Iir_Kind_Through_Quantity_Declaration - --Iir_Kind_Enumeration_Literal - --Iir_Kind_Function_Declaration - --Iir_Kind_Implicit_Function_Declaration - --Iir_Kind_Implicit_Procedure_Declaration - --Iir_Kind_Procedure_Declaration - --Iir_Kind_Function_Body - --Iir_Kind_Procedure_Body - --Iir_Kind_Object_Alias_Declaration - --Iir_Kind_File_Declaration - --Iir_Kind_Guard_Signal_Declaration - --Iir_Kind_Signal_Declaration - --Iir_Kind_Variable_Declaration - --Iir_Kind_Constant_Declaration - --Iir_Kind_Iterator_Declaration - --Iir_Kind_Interface_Constant_Declaration - --Iir_Kind_Interface_Variable_Declaration - --Iir_Kind_Interface_Signal_Declaration - Iir_Kind_Interface_File_Declaration; - - ------------------------------------- - -- Types and subtypes declarations -- - ------------------------------------- - - -- Level 1 base class. - subtype Iir is Nodes.Node_Type; - subtype Iir_List is Lists.List_Type; - Null_Iir_List : constant Iir_List := Lists.Null_List; - Iir_List_All : constant Iir_List := Lists.List_All; - Iir_List_Others : constant Iir_List := Lists.List_Others; - subtype Iir_Lists_All_Others is Iir_List - range Iir_List_Others .. Iir_List_All; - - Null_Iir : constant Iir := Nodes.Null_Node; - - function Is_Null (Node : Iir) return Boolean; - pragma Inline (Is_Null); - - function Is_Null_List (Node : Iir_List) return Boolean; - pragma Inline (Is_Null_List); - - function "=" (L, R : Iir) return Boolean renames Nodes."="; - - function Get_Last_Node return Iir renames Nodes.Get_Last_Node; - - function Create_Iir_List return Iir_List - renames Lists.Create_List; - function Get_Nth_Element (L : Iir_List; N : Natural) return Iir - renames Lists.Get_Nth_Element; - procedure Replace_Nth_Element (L : Iir_List; N : Natural; El : Iir) - renames Lists.Replace_Nth_Element; - procedure Append_Element (L : Iir_List; E : Iir) - renames Lists.Append_Element; - procedure Add_Element (L : Iir_List; E : Iir) - renames Lists.Add_Element; - procedure Destroy_Iir_List (L : in out Iir_List) - renames Lists.Destroy_List; - function Get_Nbr_Elements (L : Iir_List) return Natural - renames Lists.Get_Nbr_Elements; - procedure Set_Nbr_Elements (L : Iir_List; Nbr : Natural) - renames Lists.Set_Nbr_Elements; - function Get_First_Element (L : Iir_List) return Iir - renames Lists.Get_First_Element; - function Get_Last_Element (L : Iir_List) return Iir - renames Lists.Get_Last_Element; - function "=" (L, R : Iir_List) return Boolean renames Lists."="; - - -- This is used only for lists. - type Iir_Array is array (Natural range <>) of Iir; - type Iir_Array_Acc is access Iir_Array; - procedure Free is new Ada.Unchecked_Deallocation - (Object => Iir_Array, Name => Iir_Array_Acc); - - -- Date State. - -- This indicates the origin of the data information. - -- This also indicates the state of the unit (loaded or not). - type Date_State_Type is - ( - -- The unit is not yet in the library. - Date_Extern, - - -- The unit is not loaded (still on the disk). - -- All the informations come from the library file. - Date_Disk, - - -- The unit has been parsed, but not analyzed. - -- Only the date information come from the library. - Date_Parse, - - -- The unit has been analyzed. - Date_Analyze - ); - - -- A date is used for analysis order. All design units from a library - -- are ordered according to the date. - type Date_Type is new Nat32; - -- The unit is obseleted (ie replaced) by a more recently analyzed design - -- unit.another design unit. - -- If another design unit depends (directly or not) on an obseleted design - -- unit, it is also obselete, and cannot be defined. - Date_Obsolete : constant Date_Type := 0; - -- The unit was not analyzed. - Date_Not_Analyzed : constant Date_Type := 1; - -- The unit has been analyzed but it has bad dependences. - Date_Bad_Analyze : constant Date_Type := 2; - -- The unit has been parsed but not analyzed. - Date_Parsed : constant Date_Type := 4; - -- The unit is being analyzed. - Date_Analyzing : constant Date_Type := 5; - -- This unit has just been analyzed and should be marked at the last - -- analyzed unit. - Date_Analyzed : constant Date_Type := 6; - -- Used only for default configuration. - -- Such units are always up-to-date. - Date_Uptodate : constant Date_Type := 7; - subtype Date_Valid is Date_Type range 10 .. Date_Type'Last; - - -- Predefined depth values. - -- Depth of a subprogram not declared in another subprogram. - Iir_Depth_Top : constant Iir_Int32 := 0; - -- Purity depth of a pure subprogram. - Iir_Depth_Pure : constant Iir_Int32 := Iir_Int32'Last; - -- Purity depth of an impure subprogram. - Iir_Depth_Impure : constant Iir_Int32 := -1; - - type Base_Type is (Base_2, Base_8, Base_16); - - -- design file - subtype Iir_Design_File is Iir; - - subtype Iir_Design_Unit is Iir; - - subtype Iir_Library_Clause is Iir; - - -- Literals. - --subtype Iir_Text_Literal is Iir; - - subtype Iir_Character_Literal is Iir; - - subtype Iir_Integer_Literal is Iir; - - subtype Iir_Floating_Point_Literal is Iir; - - subtype Iir_String_Literal is Iir; - - subtype Iir_Bit_String_Literal is Iir; - - subtype Iir_Null_Literal is Iir; - - subtype Iir_Physical_Int_Literal is Iir; - - subtype Iir_Physical_Fp_Literal is Iir; - - subtype Iir_Enumeration_Literal is Iir; - - subtype Iir_Simple_Aggregate is Iir; - - subtype Iir_Enumeration_Type_Definition is Iir; - - subtype Iir_Enumeration_Subtype_Definition is Iir; - - subtype Iir_Range_Expression is Iir; - - subtype Iir_Integer_Subtype_Definition is Iir; - - subtype Iir_Integer_Type_Definition is Iir; - - subtype Iir_Floating_Subtype_Definition is Iir; - - subtype Iir_Floating_Type_Definition is Iir; - - subtype Iir_Array_Type_Definition is Iir; - - subtype Iir_Record_Type_Definition is Iir; - - subtype Iir_Protected_Type_Declaration is Iir; - - subtype Iir_Protected_Type_Body is Iir; - - subtype Iir_Subtype_Definition is Iir; - - subtype Iir_Array_Subtype_Definition is Iir; - - subtype Iir_Physical_Type_Definition is Iir; - - subtype Iir_Physical_Subtype_Definition is Iir; - - subtype Iir_Access_Type_Definition is Iir; - - subtype Iir_Access_Subtype_Definition is Iir; - - subtype Iir_File_Type_Definition is Iir; - - subtype Iir_Waveform_Element is Iir; - - subtype Iir_Conditional_Waveform is Iir; - - subtype Iir_Association_Element_By_Expression is Iir; - - subtype Iir_Association_Element_By_Individual is Iir; - - subtype Iir_Association_Element_Open is Iir; - - subtype Iir_Signature is Iir; - - subtype Iir_Unit_Declaration is Iir; - - subtype Iir_Entity_Aspect_Entity is Iir; - - subtype Iir_Entity_Aspect_Configuration is Iir; - - subtype Iir_Entity_Aspect_Open is Iir; - - subtype Iir_Block_Configuration is Iir; - - subtype Iir_Block_Header is Iir; - - subtype Iir_Component_Configuration is Iir; - - subtype Iir_Binding_Indication is Iir; - - subtype Iir_Entity_Class is Iir; - - subtype Iir_Attribute_Specification is Iir; - - subtype Iir_Attribute_Value is Iir; - - subtype Iir_Selected_Element is Iir; - - subtype Iir_Implicit_Dereference is Iir; - - subtype Iir_Aggregate_Info is Iir; - - subtype Iir_Procedure_Call is Iir; - - subtype Iir_Disconnection_Specification is Iir; - - -- Lists. - - subtype Iir_Index_List is Iir_List; - - subtype Iir_Design_Unit_List is Iir_List; - - subtype Iir_Enumeration_Literal_List is Iir_List; - - subtype Iir_Designator_List is Iir_List; - - subtype Iir_Attribute_Value_Chain is Iir_List; - - subtype Iir_Overload_List is Iir; - - subtype Iir_Group_Constituent_List is Iir_List; - - subtype Iir_Callees_List is Iir_List; - - -- Declaration and children. - subtype Iir_Entity_Declaration is Iir; - - subtype Iir_Architecture_Body is Iir; - - subtype Iir_Interface_Signal_Declaration is Iir; - - subtype Iir_Configuration_Declaration is Iir; - - subtype Iir_Type_Declaration is Iir; - - subtype Iir_Anonymous_Type_Declaration is Iir; - - subtype Iir_Subtype_Declaration is Iir; - - subtype Iir_Package_Declaration is Iir; - subtype Iir_Package_Body is Iir; - - subtype Iir_Library_Declaration is Iir; - - subtype Iir_Function_Declaration is Iir; - - subtype Iir_Function_Body is Iir; - - subtype Iir_Procedure_Declaration is Iir; - - subtype Iir_Procedure_Body is Iir; - - subtype Iir_Implicit_Function_Declaration is Iir; - - subtype Iir_Implicit_Procedure_Declaration is Iir; - - subtype Iir_Use_Clause is Iir; - - subtype Iir_Constant_Declaration is Iir; - - subtype Iir_Iterator_Declaration is Iir; - - subtype Iir_Interface_Constant_Declaration is Iir; - - subtype Iir_Interface_Variable_Declaration is Iir; - - subtype Iir_Interface_File_Declaration is Iir; - - subtype Iir_Guard_Signal_Declaration is Iir; - - subtype Iir_Signal_Declaration is Iir; - - subtype Iir_Variable_Declaration is Iir; - - subtype Iir_Component_Declaration is Iir; - - subtype Iir_Element_Declaration is Iir; - - subtype Iir_Object_Alias_Declaration is Iir; - - subtype Iir_Non_Object_Alias_Declaration is Iir; - - subtype Iir_Interface_Declaration is Iir; - - subtype Iir_Configuration_Specification is Iir; - - subtype Iir_File_Declaration is Iir; - - subtype Iir_Attribute_Declaration is Iir; - - subtype Iir_Group_Template_Declaration is Iir; - - subtype Iir_Group_Declaration is Iir; - - -- concurrent_statement and children. - subtype Iir_Concurrent_Statement is Iir; - - subtype Iir_Concurrent_Conditional_Signal_Assignment is Iir; - - subtype Iir_Sensitized_Process_Statement is Iir; - - subtype Iir_Process_Statement is Iir; - - subtype Iir_Component_Instantiation_Statement is Iir; - - subtype Iir_Block_Statement is Iir; - - subtype Iir_Generate_Statement is Iir; - - -- sequential statements. - subtype Iir_If_Statement is Iir; - - subtype Iir_Elsif is Iir; - - subtype Iir_For_Loop_Statement is Iir; - - subtype Iir_While_Loop_Statement is Iir; - - subtype Iir_Exit_Statement is Iir; - subtype Iir_Next_Statement is Iir; - - subtype Iir_Variable_Assignment_Statement is Iir; - - subtype Iir_Signal_Assignment_Statement is Iir; - - subtype Iir_Assertion_Statement is Iir; - - subtype Iir_Report_Statement is Iir; - - subtype Iir_Wait_Statement is Iir; - - subtype Iir_Return_Statement is Iir; - - subtype Iir_Case_Statement is Iir; - - subtype Iir_Procedure_Call_Statement is Iir; - - -- expression and children. - subtype Iir_Expression is Iir; - - subtype Iir_Function_Call is Iir; - - subtype Iir_Aggregate is Iir; - - subtype Iir_Qualified_Expression is Iir; - - subtype Iir_Type_Conversion is Iir; - - subtype Iir_Allocator_By_Expression is Iir; - - subtype Iir_Allocator_By_Subtype is Iir; - - -- names. - subtype Iir_Simple_Name is Iir; - - subtype Iir_Slice_Name is Iir; - - subtype Iir_Selected_Name is Iir; - - subtype Iir_Selected_By_All_Name is Iir; - - subtype Iir_Indexed_Name is Iir; - - subtype Iir_Parenthesis_Name is Iir; - - -- attributes. - subtype Iir_Attribute_Name is Iir; - - -- General methods. - - -- Get the kind of the iir. - function Get_Kind (An_Iir: Iir) return Iir_Kind; - pragma Inline (Get_Kind); - - -- Create a new IIR of kind NEW_KIND, and copy fields from SRC to this - -- iir. Src fields are cleaned. - --function Clone_Iir (Src: Iir; New_Kind : Iir_Kind) return Iir; - - procedure Set_Location (Target: Iir; Location: Location_Type) - renames Nodes.Set_Location; - function Get_Location (Target: Iir) return Location_Type - renames Nodes.Get_Location; - - procedure Location_Copy (Target: Iir; Src: Iir); - - function Create_Iir (Kind: Iir_Kind) return Iir; - function Create_Iir_Error return Iir; - procedure Free_Iir (Target: Iir) renames Nodes.Free_Node; - - -- Disp statistics about node usage. - procedure Disp_Stats; - - -- Design units contained in a design file. - -- Field: Field5 Chain - function Get_First_Design_Unit (Design : Iir) return Iir; - procedure Set_First_Design_Unit (Design : Iir; Chain : Iir); - - -- Field: Field6 Ref - function Get_Last_Design_Unit (Design : Iir) return Iir; - procedure Set_Last_Design_Unit (Design : Iir; Chain : Iir); - - -- Library declaration of a library clause. - -- Field: Field1 - function Get_Library_Declaration (Design : Iir) return Iir; - procedure Set_Library_Declaration (Design : Iir; Library : Iir); - - -- File time stamp is the system time of the file last modification. - -- Field: Field4 (uc) - function Get_File_Time_Stamp (Design : Iir) return Time_Stamp_Id; - procedure Set_File_Time_Stamp (Design : Iir; Stamp : Time_Stamp_Id); - - -- Time stamp of the last analysis system time. - -- Field: Field3 (uc) - function Get_Analysis_Time_Stamp (Design : Iir) return Time_Stamp_Id; - procedure Set_Analysis_Time_Stamp (Design : Iir; Stamp : Time_Stamp_Id); - - -- The library which FILE belongs to. - -- Field: Field0 Ref - function Get_Library (File : Iir_Design_File) return Iir; - procedure Set_Library (File : Iir_Design_File; Lib : Iir); - - -- List of files which this design file depends on. - -- Field: Field1 (uc) - function Get_File_Dependence_List (File : Iir_Design_File) return Iir_List; - procedure Set_File_Dependence_List (File : Iir_Design_File; Lst : Iir_List); - - -- Identifier for the design file file name. - -- Field: Field12 (pos) - function Get_Design_File_Filename (File : Iir_Design_File) return Name_Id; - procedure Set_Design_File_Filename (File : Iir_Design_File; Name : Name_Id); - - -- Directory of a design file. - -- Field: Field11 (pos) - function Get_Design_File_Directory (File : Iir_Design_File) return Name_Id; - procedure Set_Design_File_Directory (File : Iir_Design_File; Dir : Name_Id); - - -- The parent of a design unit is a design file. - -- Field: Field0 Ref - function Get_Design_File (Unit : Iir_Design_Unit) return Iir; - procedure Set_Design_File (Unit : Iir_Design_Unit; File : Iir); - - -- Design files of a library. - -- Field: Field1 Chain - function Get_Design_File_Chain (Library : Iir) return Iir; - procedure Set_Design_File_Chain (Library : Iir; Chain : Iir); - - -- System directory where the library is stored. - -- Field: Field11 (pos) - function Get_Library_Directory (Library : Iir) return Name_Id; - procedure Set_Library_Directory (Library : Iir; Dir : Name_Id); - - -- Symbolic date, used to order design units in a library. - -- Field: Field10 (pos) - function Get_Date (Target : Iir) return Date_Type; - procedure Set_Date (Target : Iir; Date : Date_Type); - - -- Chain of context clauses. - -- Field: Field1 Chain - function Get_Context_Items (Design_Unit : Iir) return Iir; - procedure Set_Context_Items (Design_Unit : Iir; Items_Chain : Iir); - - -- List of design units on which the design unit depends. There is an - -- exception: the architecture of an entity aspect (of a component - -- instantiation) may not have been analyzed. The Entity_Aspect_Entity - -- is added to this list (instead of the non-existing design unit). - -- Field: Field8 Of_Ref (uc) - function Get_Dependence_List (Unit : Iir) return Iir_List; - procedure Set_Dependence_List (Unit : Iir; List : Iir_List); - - -- List of functions or sensitized processes whose analysis checks are not - -- complete. - -- These elements have direct or indirect calls to procedure whose body is - -- not yet analyzed. Therefore, purity or wait checks are not complete. - -- Field: Field9 (uc) - function Get_Analysis_Checks_List (Unit : Iir) return Iir_List; - procedure Set_Analysis_Checks_List (Unit : Iir; List : Iir_List); - - -- Wether the unit is on disk, parsed or analyzed. - -- Field: State1 (pos) - function Get_Date_State (Unit : Iir_Design_Unit) return Date_State_Type; - procedure Set_Date_State (Unit : Iir_Design_Unit; State : Date_State_Type); - - -- If TRUE, the target of the signal assignment is guarded. - -- If FALSE, the target is not guarded. - -- This is determined during sem by examining the declaration(s) of the - -- target (there may be severals declarations in the case of a aggregate - -- target). - -- If UNKNOWN, this is not determined at compile time but at run-time. - -- This is the case for formal signal interfaces of subprograms. - -- Field: State3 (pos) - function Get_Guarded_Target_State (Stmt : Iir) return Tri_State_Type; - procedure Set_Guarded_Target_State (Stmt : Iir; State : Tri_State_Type); - - -- Library unit of a design unit. - -- Field: Field5 - function Get_Library_Unit (Design_Unit : Iir_Design_Unit) return Iir; - procedure Set_Library_Unit (Design_Unit : Iir_Design_Unit; Lib_Unit : Iir); - pragma Inline (Get_Library_Unit); - - -- Every design unit is put in an hash table to find quickly found by its - -- name. This field is a single chain for collisions. - -- Field: Field7 Ref - function Get_Hash_Chain (Design_Unit : Iir_Design_Unit) return Iir; - procedure Set_Hash_Chain (Design_Unit : Iir_Design_Unit; Chain : Iir); - - -- Set the line and the offset in the line, only for the library manager. - -- This is valid until the file is really loaded in memory. On loading, - -- location will contain all this informations. - -- Field: Field4 (uc) - function Get_Design_Unit_Source_Pos (Design_Unit : Iir) return Source_Ptr; - procedure Set_Design_Unit_Source_Pos (Design_Unit : Iir; Pos : Source_Ptr); - - -- Field: Field11 (uc) - function Get_Design_Unit_Source_Line (Design_Unit : Iir) return Int32; - procedure Set_Design_Unit_Source_Line (Design_Unit : Iir; Line : Int32); - - -- Field: Field12 (uc) - function Get_Design_Unit_Source_Col (Design_Unit : Iir) return Int32; - procedure Set_Design_Unit_Source_Col (Design_Unit : Iir; Line : Int32); - - -- literals. - - -- Value of an integer/physical literal. - -- Field: Int64 - function Get_Value (Lit : Iir) return Iir_Int64; - procedure Set_Value (Lit : Iir; Val : Iir_Int64); - - -- Position (same as lit_type'pos) of an enumeration literal. - -- Field: Field10 (pos) - function Get_Enum_Pos (Lit : Iir) return Iir_Int32; - procedure Set_Enum_Pos (Lit : Iir; Val : Iir_Int32); - - -- Field: Field6 - function Get_Physical_Literal (Unit : Iir) return Iir; - procedure Set_Physical_Literal (Unit : Iir; Lit : Iir); - - -- Value of a physical unit declaration. - -- Field: Field7 - function Get_Physical_Unit_Value (Unit : Iir) return Iir; - procedure Set_Physical_Unit_Value (Unit : Iir; Lit : Iir); - - -- Value of a floating point literal. - -- Field: Fp64 - function Get_Fp_Value (Lit : Iir) return Iir_Fp64; - procedure Set_Fp_Value (Lit : Iir; Val : Iir_Fp64); - - -- Declaration of the literal. - -- This is used to retrieve the genuine enumeration literal for literals - -- created from static expression. - -- Field: Field6 Ref - function Get_Enumeration_Decl (Target : Iir) return Iir; - procedure Set_Enumeration_Decl (Target : Iir; Lit : Iir); - - -- List of elements of a simple aggregate. - -- Field: Field3 (uc) - function Get_Simple_Aggregate_List (Target : Iir) return Iir_List; - procedure Set_Simple_Aggregate_List (Target : Iir; List : Iir_List); - - -- The logarithm of the base (1, 3 or 4) of a bit string. - -- Field: Field8 (pos) - function Get_Bit_String_Base (Lit : Iir) return Base_Type; - procedure Set_Bit_String_Base (Lit : Iir; Base : Base_Type); - - -- The enumeration literal which defines the '0' and '1' value. - -- Field: Field6 - function Get_Bit_String_0 (Lit : Iir) return Iir; - procedure Set_Bit_String_0 (Lit : Iir; El : Iir); - - -- Field: Field7 - function Get_Bit_String_1 (Lit : Iir) return Iir; - procedure Set_Bit_String_1 (Lit : Iir; El : Iir); - - -- The origin of a literal can be null_iir for a literal generated by the - -- parser, or a node which was statically evaluated to this literal. - -- Such nodes are created by eval_expr. - -- Field: Field2 - function Get_Literal_Origin (Lit : Iir) return Iir; - procedure Set_Literal_Origin (Lit : Iir; Orig : Iir); - - -- Field: Field4 - function Get_Range_Origin (Lit : Iir) return Iir; - procedure Set_Range_Origin (Lit : Iir; Orig : Iir); - - -- Same as Type, but not marked as Ref. This is when a literal has a - -- subtype (such as string or bit_string) created specially for the - -- literal. - -- Field: Field5 - function Get_Literal_Subtype (Lit : Iir) return Iir; - procedure Set_Literal_Subtype (Lit : Iir; Atype : Iir); - - -- Field: Field3 (uc) - function Get_Entity_Class (Target : Iir) return Token_Type; - procedure Set_Entity_Class (Target : Iir; Kind : Token_Type); - - -- Field: Field1 (uc) - function Get_Entity_Name_List (Target : Iir) return Iir_List; - procedure Set_Entity_Name_List (Target : Iir; Names : Iir_List); - - -- Field: Field6 - function Get_Attribute_Designator (Target : Iir) return Iir; - procedure Set_Attribute_Designator (Target : Iir; Designator : Iir); - - -- Chain of attribute specifications. This is used only during sem, to - -- check that no named entity of a given class appear after an attr. spec. - -- with the entity name list OTHERS or ALL. - -- Field: Field7 - function Get_Attribute_Specification_Chain (Target : Iir) return Iir; - procedure Set_Attribute_Specification_Chain (Target : Iir; Chain : Iir); - - -- Field: Field4 Ref - function Get_Attribute_Specification (Val : Iir) return Iir; - procedure Set_Attribute_Specification (Val : Iir; Attr : Iir); - - -- Field: Field3 (uc) - function Get_Signal_List (Target : Iir) return Iir_List; - procedure Set_Signal_List (Target : Iir; List : Iir_List); - - -- Field: Field3 Ref - function Get_Designated_Entity (Val : Iir_Attribute_Value) return Iir; - procedure Set_Designated_Entity (Val : Iir_Attribute_Value; Entity : Iir); - - -- Field: Field1 - function Get_Formal (Target : Iir) return Iir; - procedure Set_Formal (Target : Iir; Formal : Iir); - - -- Field: Field3 - function Get_Actual (Target : Iir) return Iir; - procedure Set_Actual (Target : Iir; Actual : Iir); - - -- Field: Field4 - function Get_In_Conversion (Target : Iir) return Iir; - procedure Set_In_Conversion (Target : Iir; Conv : Iir); - - -- Field: Field5 - function Get_Out_Conversion (Target : Iir) return Iir; - procedure Set_Out_Conversion (Target : Iir; Conv : Iir); - - -- This flag is set when the formal is associated in whole (ie, not - -- individually). - -- Field: Flag1 - function Get_Whole_Association_Flag (Target : Iir) return Boolean; - procedure Set_Whole_Association_Flag (Target : Iir; Flag : Boolean); - - -- This flag is set when the formal signal can be the actual signal. In - -- this case, the formal signal is not created, and the actual is shared. - -- This is the signal collapsing optimisation. - -- Field: Flag2 - function Get_Collapse_Signal_Flag (Target : Iir) return Boolean; - procedure Set_Collapse_Signal_Flag (Target : Iir; Flag : Boolean); - - -- Set when the node was artificially created, eg by canon. - -- Currently used only by association_element_open. - -- Field: Flag3 - function Get_Artificial_Flag (Target : Iir) return Boolean; - procedure Set_Artificial_Flag (Target : Iir; Flag : Boolean); - - -- This flag is set for a very short time during the check that no in - -- port is unconnected. - -- Field: Flag3 - function Get_Open_Flag (Target : Iir) return Boolean; - procedure Set_Open_Flag (Target : Iir; Flag : Boolean); - - -- This flag is set by trans_analyze if there is a projected waveform - -- assignment in the process. - -- Field: Flag5 - function Get_After_Drivers_Flag (Target : Iir) return Boolean; - procedure Set_After_Drivers_Flag (Target : Iir; Flag : Boolean); - - -- Field: Field1 - function Get_We_Value (We : Iir_Waveform_Element) return Iir; - procedure Set_We_Value (We : Iir_Waveform_Element; An_Iir : Iir); - - -- Field: Field3 - function Get_Time (We : Iir_Waveform_Element) return Iir; - procedure Set_Time (We : Iir_Waveform_Element; An_Iir : Iir); - - -- Node associated with a choice. - -- Field: Field3 - function Get_Associated_Expr (Target : Iir) return Iir; - procedure Set_Associated_Expr (Target : Iir; Associated : Iir); - - -- Chain associated with a choice. - -- Field: Field4 Chain - function Get_Associated_Chain (Target : Iir) return Iir; - procedure Set_Associated_Chain (Target : Iir; Associated : Iir); - - -- Field: Field5 - function Get_Choice_Name (Choice : Iir) return Iir; - procedure Set_Choice_Name (Choice : Iir; Name : Iir); - - -- Field: Field5 - function Get_Choice_Expression (Choice : Iir) return Iir; - procedure Set_Choice_Expression (Choice : Iir; Name : Iir); - - -- Field: Field5 - function Get_Choice_Range (Choice : Iir) return Iir; - procedure Set_Choice_Range (Choice : Iir; Name : Iir); - - -- Set when a choice belongs to the same alternative as the previous one. - -- Field: Flag1 - function Get_Same_Alternative_Flag (Target : Iir) return Boolean; - procedure Set_Same_Alternative_Flag (Target : Iir; Val : Boolean); - - -- Field: Field3 - function Get_Architecture (Target : Iir_Entity_Aspect_Entity) return Iir; - procedure Set_Architecture (Target : Iir_Entity_Aspect_Entity; Arch : Iir); - - -- Field: Field5 - function Get_Block_Specification (Target : Iir) return Iir; - procedure Set_Block_Specification (Target : Iir; Block : Iir); - - -- Return the link of the previous block_configuration of a - -- block_configuration. - -- This single linked list is used to list all the block_configuration that - -- configuration the same block (which can only be an iterative generate - -- statement). - -- All elements of this list must belong to the same block configuration. - -- The order is not important. - -- Field: Field4 Ref - function Get_Prev_Block_Configuration (Target : Iir) return Iir; - procedure Set_Prev_Block_Configuration (Target : Iir; Block : Iir); - - -- Field: Field3 Chain - function Get_Configuration_Item_Chain (Target : Iir) return Iir; - procedure Set_Configuration_Item_Chain (Target : Iir; Chain : Iir); - - -- Chain of attribute values for a named entity. - -- To be used with Get/Set_Chain. - -- There is no order, therefore, a new attribute value may be always - -- prepended. - -- Field: Field4 Chain - function Get_Attribute_Value_Chain (Target : Iir) return Iir; - procedure Set_Attribute_Value_Chain (Target : Iir; Chain : Iir); - - -- Next attribute value in the attribute specification chain (of attribute - -- value). - -- Field: Field0 - function Get_Spec_Chain (Target : Iir) return Iir; - procedure Set_Spec_Chain (Target : Iir; Chain : Iir); - - -- Chain of attribute values for attribute specification. - -- To be used with Get/Set_Spec_Chain. - -- Field: Field4 - function Get_Attribute_Value_Spec_Chain (Target : Iir) return Iir; - procedure Set_Attribute_Value_Spec_Chain (Target : Iir; Chain : Iir); - - -- The entity name for an architecture or a configuration. - -- Field: Field2 - function Get_Entity_Name (Arch : Iir) return Iir; - procedure Set_Entity_Name (Arch : Iir; Entity : Iir); - - -- The package declaration corresponding to the body. - -- Field: Field4 Ref - function Get_Package (Package_Body : Iir) return Iir; - procedure Set_Package (Package_Body : Iir; Decl : Iir); - - -- The package body corresponding to the package declaration. - -- Field: Field2 Ref - function Get_Package_Body (Pkg : Iir) return Iir; - procedure Set_Package_Body (Pkg : Iir; Decl : Iir); - - -- If true, the package need a body. - -- Field: Flag1 - function Get_Need_Body (Decl : Iir_Package_Declaration) return Boolean; - procedure Set_Need_Body (Decl : Iir_Package_Declaration; Flag : Boolean); - - -- Field: Field5 - function Get_Block_Configuration (Target : Iir) return Iir; - procedure Set_Block_Configuration (Target : Iir; Block : Iir); - - -- Field: Field5 Chain - function Get_Concurrent_Statement_Chain (Target : Iir) return Iir; - procedure Set_Concurrent_Statement_Chain (Target : Iir; First : Iir); - - -- Field: Field2 Chain_Next - function Get_Chain (Target : Iir) return Iir; - procedure Set_Chain (Target : Iir; Chain : Iir); - pragma Inline (Get_Chain); - - -- Field: Field7 Chain - function Get_Port_Chain (Target : Iir) return Iir; - procedure Set_Port_Chain (Target : Iir; Chain : Iir); - - -- Field: Field6 Chain - function Get_Generic_Chain (Target : Iir) return Iir; - procedure Set_Generic_Chain (Target : Iir; Generics : Iir); - - -- Field: Field1 Ref - function Get_Type (Target : Iir) return Iir; - procedure Set_Type (Target : Iir; Atype : Iir); - pragma Inline (Get_Type); - - -- The subtype indication of a declaration. Note that this node can be - -- shared between declarations if they are separated by comma, such as in: - -- variable a, b : integer := 5; - -- Field: Field5 Maybe_Ref - function Get_Subtype_Indication (Target : Iir) return Iir; - procedure Set_Subtype_Indication (Target : Iir; Atype : Iir); - - -- Field: Field6 - function Get_Discrete_Range (Target : Iir) return Iir; - procedure Set_Discrete_Range (Target : Iir; Rng : Iir); - - -- Field: Field1 - function Get_Type_Definition (Decl : Iir) return Iir; - procedure Set_Type_Definition (Decl : Iir; Atype : Iir); - - -- The subtype definition associated with the type declaration (if any). - -- Field: Field4 - function Get_Subtype_Definition (Target : Iir) return Iir; - procedure Set_Subtype_Definition (Target : Iir; Def : Iir); - - -- Field: Field1 - function Get_Nature (Target : Iir) return Iir; - procedure Set_Nature (Target : Iir; Nature : Iir); - - -- Mode of interfaces or file (v87). - -- Field: Odigit1 (pos) - function Get_Mode (Target : Iir) return Iir_Mode; - procedure Set_Mode (Target : Iir; Mode : Iir_Mode); - - -- Field: State3 (pos) - function Get_Signal_Kind (Target : Iir) return Iir_Signal_Kind; - procedure Set_Signal_Kind (Target : Iir; Signal_Kind : Iir_Signal_Kind); - - -- The base name of a name is the node at the origin of the name. - -- The base name is a declaration (signal, object, constant or interface), - -- a selected_by_all name, an implicit_dereference name. - -- Field: Field5 Ref - function Get_Base_Name (Target : Iir) return Iir; - procedure Set_Base_Name (Target : Iir; Name : Iir); - pragma Inline (Get_Base_Name); - - -- Field: Field5 Chain - function Get_Interface_Declaration_Chain (Target : Iir) return Iir; - procedure Set_Interface_Declaration_Chain (Target : Iir; Chain : Iir); - pragma Inline (Get_Interface_Declaration_Chain); - - -- Field: Field4 Ref - function Get_Subprogram_Specification (Target : Iir) return Iir; - procedure Set_Subprogram_Specification (Target : Iir; Spec : Iir); - - -- Field: Field5 Chain - function Get_Sequential_Statement_Chain (Target : Iir) return Iir; - procedure Set_Sequential_Statement_Chain (Target : Iir; Chain : Iir); - - -- Field: Field9 Ref - function Get_Subprogram_Body (Target : Iir) return Iir; - procedure Set_Subprogram_Body (Target : Iir; A_Body : Iir); - - -- Several subprograms in a declarative region may have the same - -- identifier. If the overload number is not 0, it is the rank of the - -- subprogram. If the overload number is 0, then the identifier is not - -- overloaded in the declarative region. - -- Field: Field12 (pos) - function Get_Overload_Number (Target : Iir) return Iir_Int32; - procedure Set_Overload_Number (Target : Iir; Val : Iir_Int32); - - -- Depth of a subprogram. - -- For a subprogram declared immediatly within an entity, architecture, - -- package, process, block, generate, the depth is 0. - -- For a subprogram declared immediatly within a subprogram of level N, - -- the depth is N + 1. - -- Depth is used with depth of impure objects to check purity rules. - -- Field: Field10 (pos) - function Get_Subprogram_Depth (Target : Iir) return Iir_Int32; - procedure Set_Subprogram_Depth (Target : Iir; Depth : Iir_Int32); - - -- Hash of a subprogram profile. - -- This is used to speed up subprogram profile comparaison, which is very - -- often used by overload. - -- Field: Field11 (pos) - function Get_Subprogram_Hash (Target : Iir) return Iir_Int32; - procedure Set_Subprogram_Hash (Target : Iir; Val : Iir_Int32); - pragma Inline (Get_Subprogram_Hash); - - -- Depth of the deepest impure object. - -- Field: Field3 (uc) - function Get_Impure_Depth (Target : Iir) return Iir_Int32; - procedure Set_Impure_Depth (Target : Iir; Depth : Iir_Int32); - - -- Field: Field1 Ref - function Get_Return_Type (Target : Iir) return Iir; - procedure Set_Return_Type (Target : Iir; Decl : Iir); - pragma Inline (Get_Return_Type); - - -- Code of an implicit subprogram definition. - -- Field: Field9 (pos) - function Get_Implicit_Definition (D : Iir) return Iir_Predefined_Functions; - procedure Set_Implicit_Definition (D : Iir; Def : Iir_Predefined_Functions); - - -- For an implicit subprogram, the type_reference is the type declaration - -- for which the implicit subprogram was defined. - -- Field: Field10 Ref - function Get_Type_Reference (Target : Iir) return Iir; - procedure Set_Type_Reference (Target : Iir; Decl : Iir); - - -- Get the default value of an object declaration. - -- Null_iir if no default value. - -- Note that this node can be shared between declarations if they are - -- separated by comma, such as in: - -- variable a, b : integer := 5; - -- Field: Field6 Maybe_Ref - function Get_Default_Value (Target : Iir) return Iir; - procedure Set_Default_Value (Target : Iir; Value : Iir); - - -- The deferred_declaration field points to the deferred constant - -- declaration for a full constant declaration, or is null_iir for a - -- usual or deferred constant declaration. - -- Set only during sem. - -- Field: Field7 - function Get_Deferred_Declaration (Target : Iir) return Iir; - procedure Set_Deferred_Declaration (Target : Iir; Decl : Iir); - - -- The deferred_declaration_flag must be set if the constant declaration is - -- a deferred_constant declaration. - -- Set only during sem. - -- Field: Flag1 - function Get_Deferred_Declaration_Flag (Target : Iir) return Boolean; - procedure Set_Deferred_Declaration_Flag (Target : Iir; Flag : Boolean); - - -- If true, the variable is declared shared. - -- Field: Flag2 - function Get_Shared_Flag (Target : Iir) return Boolean; - procedure Set_Shared_Flag (Target : Iir; Shared : Boolean); - - -- Get the design unit in which the target is declared. - -- For a library unit, this is to get the design unit node. - -- Field: Field0 - function Get_Design_Unit (Target : Iir) return Iir; - procedure Set_Design_Unit (Target : Iir; Unit : Iir); - - -- Field: Field7 - function Get_Block_Statement (Target : Iir) return Iir; - procedure Set_Block_Statement (Target : Iir; Block : Iir); - - -- For a non-resolved signal: null_iir if the signal has no driver, or - -- a process/concurrent_statement for which the signal should have a - -- driver. This is used to catch at analyse time unresolved signals with - -- several drivers. - -- Field: Field7 - function Get_Signal_Driver (Target : Iir_Signal_Declaration) return Iir; - procedure Set_Signal_Driver (Target : Iir_Signal_Declaration; Driver : Iir); - - -- Field: Field1 Chain - function Get_Declaration_Chain (Target : Iir) return Iir; - procedure Set_Declaration_Chain (Target : Iir; Decls : Iir); - - -- Field: Field6 - function Get_File_Logical_Name (Target : Iir_File_Declaration) return Iir; - procedure Set_File_Logical_Name (Target : Iir_File_Declaration; Name : Iir); - - -- Field: Field7 - function Get_File_Open_Kind (Target : Iir_File_Declaration) return Iir; - procedure Set_File_Open_Kind (Target : Iir_File_Declaration; Kind : Iir); - - -- Field: Field4 (pos) - function Get_Element_Position (Target : Iir) return Iir_Index32; - procedure Set_Element_Position (Target : Iir; Pos : Iir_Index32); - - -- Field: Field2 - function Get_Element_Declaration (Target : Iir) return Iir; - procedure Set_Element_Declaration (Target : Iir; El : Iir); - - -- Field: Field2 Ref - function Get_Selected_Element (Target : Iir) return Iir; - procedure Set_Selected_Element (Target : Iir; El : Iir); - - -- Selected names of an use_clause are chained. - -- Field: Field3 - function Get_Use_Clause_Chain (Target : Iir) return Iir; - procedure Set_Use_Clause_Chain (Target : Iir; Chain : Iir); - - -- Selected name of an use_clause. - -- Field: Field1 - function Get_Selected_Name (Target : Iir_Use_Clause) return Iir; - procedure Set_Selected_Name (Target : Iir_Use_Clause; Name : Iir); - - -- The type declarator which declares the type definition DEF. - -- Field: Field3 Ref - function Get_Type_Declarator (Def : Iir) return Iir; - procedure Set_Type_Declarator (Def : Iir; Decl : Iir); - - -- Field: Field2 (uc) - function Get_Enumeration_Literal_List (Target : Iir) return Iir_List; - procedure Set_Enumeration_Literal_List (Target : Iir; List : Iir_List); - - -- Field: Field1 Chain - function Get_Entity_Class_Entry_Chain (Target : Iir) return Iir; - procedure Set_Entity_Class_Entry_Chain (Target : Iir; Chain : Iir); - - -- Field: Field1 (uc) - function Get_Group_Constituent_List (Group : Iir) return Iir_List; - procedure Set_Group_Constituent_List (Group : Iir; List : Iir_List); - - -- Chain of physical type units. - -- The first unit is the primary unit. If you really need the primary - -- unit (and not the chain), you'd better to use Get_Primary_Unit. - -- Field: Field1 Chain - function Get_Unit_Chain (Target : Iir) return Iir; - procedure Set_Unit_Chain (Target : Iir; Chain : Iir); - - -- Alias of Get_Unit_Chain. - -- Return the primary unit of a physical type. - -- Field: Field1 Ref - function Get_Primary_Unit (Target : Iir) return Iir; - procedure Set_Primary_Unit (Target : Iir; Unit : Iir); - - -- Get/Set the identifier of a declaration. - -- Can also be used instead of get/set_label. - -- Field: Field3 (uc) - function Get_Identifier (Target : Iir) return Name_Id; - procedure Set_Identifier (Target : Iir; Identifier : Name_Id); - pragma Inline (Get_Identifier); - - -- Field: Field3 (uc) - function Get_Label (Target : Iir) return Name_Id; - procedure Set_Label (Target : Iir; Label : Name_Id); - - -- Get/Set the visible flag of a declaration. - -- The visible flag is true to make invalid the use of the identifier - -- during its declaration. It is set to false when the identifier is added - -- to the name table, and set to true when the declaration is finished. - -- Field: Flag4 - function Get_Visible_Flag (Target : Iir) return Boolean; - procedure Set_Visible_Flag (Target : Iir; Flag : Boolean); - - -- Field: Field1 - function Get_Range_Constraint (Target : Iir) return Iir; - procedure Set_Range_Constraint (Target : Iir; Constraint : Iir); - - -- Field: State2 (pos) - function Get_Direction (Decl : Iir) return Iir_Direction; - procedure Set_Direction (Decl : Iir; Dir : Iir_Direction); - - -- Field: Field2 - function Get_Left_Limit (Decl : Iir_Range_Expression) return Iir; - procedure Set_Left_Limit (Decl : Iir_Range_Expression; Limit : Iir); - - -- Field: Field3 - function Get_Right_Limit (Decl : Iir_Range_Expression) return Iir; - procedure Set_Right_Limit (Decl : Iir_Range_Expression; Limit : Iir); - - -- Field: Field4 Ref - function Get_Base_Type (Decl : Iir) return Iir; - procedure Set_Base_Type (Decl : Iir; Base_Type : Iir); - pragma Inline (Get_Base_Type); - - -- Either a resolution function name, an array_element_resolution or a - -- record_resolution - -- Field: Field5 - function Get_Resolution_Indication (Decl : Iir) return Iir; - procedure Set_Resolution_Indication (Decl : Iir; Ind : Iir); - - -- Field: Field1 Chain - function Get_Record_Element_Resolution_Chain (Res : Iir) return Iir; - procedure Set_Record_Element_Resolution_Chain (Res : Iir; Chain : Iir); - - -- Field: Field7 - function Get_Tolerance (Def : Iir) return Iir; - procedure Set_Tolerance (Def : Iir; Tol : Iir); - - -- Field: Field8 - function Get_Plus_Terminal (Def : Iir) return Iir; - procedure Set_Plus_Terminal (Def : Iir; Terminal : Iir); - - -- Field: Field9 - function Get_Minus_Terminal (Def : Iir) return Iir; - procedure Set_Minus_Terminal (Def : Iir; Terminal : Iir); - - -- Field: Field5 - function Get_Simultaneous_Left (Def : Iir) return Iir; - procedure Set_Simultaneous_Left (Def : Iir; Expr : Iir); - - -- Field: Field6 - function Get_Simultaneous_Right (Def : Iir) return Iir; - procedure Set_Simultaneous_Right (Def : Iir; Expr : Iir); - - -- True if ATYPE defines std.textio.text file type. - -- Field: Flag4 - function Get_Text_File_Flag (Atype : Iir) return Boolean; - procedure Set_Text_File_Flag (Atype : Iir; Flag : Boolean); - - -- True if enumeration type ATYPE has only character literals. - -- Field: Flag4 - function Get_Only_Characters_Flag (Atype : Iir) return Boolean; - procedure Set_Only_Characters_Flag (Atype : Iir; Flag : Boolean); - - -- Field: State1 (pos) - function Get_Type_Staticness (Atype : Iir) return Iir_Staticness; - procedure Set_Type_Staticness (Atype : Iir; Static : Iir_Staticness); - - -- Field: State2 (pos) - function Get_Constraint_State (Atype : Iir) return Iir_Constraint; - procedure Set_Constraint_State (Atype : Iir; State : Iir_Constraint); - - -- Reference either index_subtype_definition_list of array_type_definition - -- or index_constraint_list of array_subtype_definition. - -- Field: Field9 Ref (uc) - function Get_Index_Subtype_List (Decl : Iir) return Iir_List; - procedure Set_Index_Subtype_List (Decl : Iir; List : Iir_List); - - -- List of type marks for indexes type of array types. - -- Field: Field6 (uc) - function Get_Index_Subtype_Definition_List (Def : Iir) return Iir_List; - procedure Set_Index_Subtype_Definition_List (Def : Iir; Idx : Iir_List); - - -- The subtype_indication as it appears in a array type declaration. - -- Field: Field2 - function Get_Element_Subtype_Indication (Decl : Iir) return Iir; - procedure Set_Element_Subtype_Indication (Decl : Iir; Sub_Type : Iir); - - -- Field: Field1 Ref - function Get_Element_Subtype (Decl : Iir) return Iir; - procedure Set_Element_Subtype (Decl : Iir; Sub_Type : Iir); - - -- Field: Field6 (uc) - function Get_Index_Constraint_List (Def : Iir) return Iir_List; - procedure Set_Index_Constraint_List (Def : Iir; List : Iir_List); - - -- Field: Field8 - function Get_Array_Element_Constraint (Def : Iir) return Iir; - procedure Set_Array_Element_Constraint (Def : Iir; El : Iir); - - -- Chains of elements of a record. - -- Field: Field1 (uc) - function Get_Elements_Declaration_List (Decl : Iir) return Iir_List; - procedure Set_Elements_Declaration_List (Decl : Iir; List : Iir_List); - - -- Field: Field1 Ref - function Get_Designated_Type (Target : Iir) return Iir; - procedure Set_Designated_Type (Target : Iir; Dtype : Iir); - - -- Field: Field5 - function Get_Designated_Subtype_Indication (Target : Iir) return Iir; - procedure Set_Designated_Subtype_Indication (Target : Iir; Dtype : Iir); - - -- List of indexes for indexed name. - -- Field: Field2 (uc) - function Get_Index_List (Decl : Iir) return Iir_List; - procedure Set_Index_List (Decl : Iir; List : Iir_List); - - -- The terminal declaration for the reference (ground) of a nature - -- Field: Field2 - function Get_Reference (Def : Iir) return Iir; - procedure Set_Reference (Def : Iir; Ref : Iir); - - -- Field: Field3 - function Get_Nature_Declarator (Def : Iir) return Iir; - procedure Set_Nature_Declarator (Def : Iir; Decl : Iir); - - -- Field: Field7 - function Get_Across_Type (Def : Iir) return Iir; - procedure Set_Across_Type (Def : Iir; Atype : Iir); - - -- Field: Field8 - function Get_Through_Type (Def : Iir) return Iir; - procedure Set_Through_Type (Def : Iir; Atype : Iir); - - -- Field: Field1 - function Get_Target (Target : Iir) return Iir; - procedure Set_Target (Target : Iir; Atarget : Iir); - - -- Field: Field5 Chain - function Get_Waveform_Chain (Target : Iir) return Iir; - procedure Set_Waveform_Chain (Target : Iir; Chain : Iir); - - -- Field: Field8 - function Get_Guard (Target : Iir) return Iir; - procedure Set_Guard (Target : Iir; Guard : Iir); - - -- Field: Field12 (pos) - function Get_Delay_Mechanism (Target : Iir) return Iir_Delay_Mechanism; - procedure Set_Delay_Mechanism (Target : Iir; Kind : Iir_Delay_Mechanism); - - -- Field: Field6 - function Get_Reject_Time_Expression (Target : Iir) return Iir; - procedure Set_Reject_Time_Expression (Target : Iir; Expr : Iir); - - -- Field: Field6 (uc) - function Get_Sensitivity_List (Wait : Iir) return Iir_List; - procedure Set_Sensitivity_List (Wait : Iir; List : Iir_List); - - -- Field: Field8 - function Get_Process_Origin (Proc : Iir) return Iir; - procedure Set_Process_Origin (Proc : Iir; Orig : Iir); - - -- Field: Field5 - function Get_Condition_Clause (Wait : Iir_Wait_Statement) return Iir; - procedure Set_Condition_Clause (Wait : Iir_Wait_Statement; Cond : Iir); - - -- Field: Field1 - function Get_Timeout_Clause (Wait : Iir_Wait_Statement) return Iir; - procedure Set_Timeout_Clause (Wait : Iir_Wait_Statement; Timeout : Iir); - - -- If set, the concurrent statement is postponed. - -- Field: Flag3 - function Get_Postponed_Flag (Target : Iir) return Boolean; - procedure Set_Postponed_Flag (Target : Iir; Value : Boolean); - - -- Returns the list of subprogram called in this subprogram or process. - -- Note: implicit function (such as implicit operators) are omitted - -- from this list, since the purpose of this list is to correctly set - -- flags for side effects (purity_state, wait_state). - -- Can return null_iir if there is no subprogram called. - -- Field: Field7 Of_Ref (uc) - function Get_Callees_List (Proc : Iir) return Iir_List; - procedure Set_Callees_List (Proc : Iir; List : Iir_List); - - -- Get/Set the passive flag of a process. - -- TRUE if the process must be passive. - -- FALSE if the process may be not passive. - -- For a procedure declaration, set if it is passive. - -- Field: Flag2 - function Get_Passive_Flag (Proc : Iir) return Boolean; - procedure Set_Passive_Flag (Proc : Iir; Flag : Boolean); - - -- True if the function is used as a resolution function. - -- Field: Flag7 - function Get_Resolution_Function_Flag (Func : Iir) return Boolean; - procedure Set_Resolution_Function_Flag (Func : Iir; Flag : Boolean); - - -- Get/Set the wait state of the current subprogram or process. - -- TRUE if it contains a wait statement, either directly or - -- indirectly. - -- FALSE if it doesn't contain a wait statement. - -- UNKNOWN if the wait status is not yet known. - -- Field: State1 (pos) - function Get_Wait_State (Proc : Iir) return Tri_State_Type; - procedure Set_Wait_State (Proc : Iir; State : Tri_State_Type); - - -- Get/Set wether the subprogram may be called by a sensitized process - -- whose sensitivity list is ALL. - -- FALSE if declared in a package unit and reads a signal that is not - -- one of its interface, or if it calls such a subprogram. - -- TRUE if it doesn't call a subprogram whose state is False and - -- either doesn't read a signal or declared within an entity or - -- architecture. - -- UNKNOWN if the status is not yet known. - -- Field: State3 (pos) - function Get_All_Sensitized_State (Proc : Iir) return Iir_All_Sensitized; - procedure Set_All_Sensitized_State (Proc : Iir; State : Iir_All_Sensitized); - - -- Get/Set the seen flag. - -- Used when the graph of callees is walked, to avoid infinite loops, since - -- the graph is not a DAG (there may be cycles). - -- Field: Flag1 - function Get_Seen_Flag (Proc : Iir) return Boolean; - procedure Set_Seen_Flag (Proc : Iir; Flag : Boolean); - - -- Get/Set the pure flag of a function. - -- TRUE if the function is declared pure. - -- FALSE if the function is declared impure. - -- Field: Flag2 - function Get_Pure_Flag (Func : Iir) return Boolean; - procedure Set_Pure_Flag (Func : Iir; Flag : Boolean); - - -- Get/Set the foreign flag of a declaration. - -- TRUE if the declaration was decored with the std.foreign attribute. - -- Field: Flag3 - function Get_Foreign_Flag (Decl : Iir) return Boolean; - procedure Set_Foreign_Flag (Decl : Iir; Flag : Boolean); - - -- Get/Set the resolved flag of a subtype definition. - -- A subtype definition may be resolved either because a - -- resolution_indication is present in the subtype_indication, or - -- because all elements type are resolved. - -- Field: Flag1 - function Get_Resolved_Flag (Atype : Iir) return Boolean; - procedure Set_Resolved_Flag (Atype : Iir; Flag : Boolean); - - -- Get/Set the signal_type flag of a type/subtype definition. - -- This flags indicates whether the type can be used as a signal type. - -- Access types, file types and composite types whose a sub-element is - -- an access type cannot be used as a signal type. - -- Field: Flag2 - function Get_Signal_Type_Flag (Atype : Iir) return Boolean; - procedure Set_Signal_Type_Flag (Atype : Iir; Flag : Boolean); - - -- True if ATYPE is used to declare a signal or to handle a signal - -- (such as slice or aliases). - -- Field: Flag3 - function Get_Has_Signal_Flag (Atype : Iir) return Boolean; - procedure Set_Has_Signal_Flag (Atype : Iir; Flag : Boolean); - - -- Get/Set the purity status of a subprogram. - -- Field: State2 (pos) - function Get_Purity_State (Proc : Iir) return Iir_Pure_State; - procedure Set_Purity_State (Proc : Iir; State : Iir_Pure_State); - - -- Set during binding when DESIGN is added in a list of file to bind. - -- Field: Flag3 - function Get_Elab_Flag (Design : Iir) return Boolean; - procedure Set_Elab_Flag (Design : Iir; Flag : Boolean); - - -- Set on an array_subtype if there is an index constraint. - -- If not set, the subtype is unconstrained. - -- Field: Flag4 - function Get_Index_Constraint_Flag (Atype : Iir) return Boolean; - procedure Set_Index_Constraint_Flag (Atype : Iir; Flag : Boolean); - - -- Condition of an assertion. - -- Field: Field1 - function Get_Assertion_Condition (Target : Iir) return Iir; - procedure Set_Assertion_Condition (Target : Iir; Cond : Iir); - - -- Report expression of an assertion or report statement. - -- Field: Field6 - function Get_Report_Expression (Target : Iir) return Iir; - procedure Set_Report_Expression (Target : Iir; Expr : Iir); - - -- Severity expression of an assertion or report statement. - -- Field: Field5 - function Get_Severity_Expression (Target : Iir) return Iir; - procedure Set_Severity_Expression (Target : Iir; Expr : Iir); - - -- Instantiated unit of a component instantiation statement. - -- Field: Field1 - function Get_Instantiated_Unit (Target : Iir) return Iir; - procedure Set_Instantiated_Unit (Target : Iir; Unit : Iir); - - -- Generic map aspect list. - -- Field: Field8 Chain - function Get_Generic_Map_Aspect_Chain (Target : Iir) return Iir; - procedure Set_Generic_Map_Aspect_Chain (Target : Iir; Generics : Iir); - - -- Port map aspect list. - -- Field: Field9 Chain - function Get_Port_Map_Aspect_Chain (Target : Iir) return Iir; - procedure Set_Port_Map_Aspect_Chain (Target : Iir; Port : Iir); - - -- Configuration of an entity_aspect_configuration. - -- Field: Field1 - function Get_Configuration_Name (Target : Iir) return Iir; - procedure Set_Configuration_Name (Target : Iir; Conf : Iir); - - -- Component configuration for a component_instantiation_statement. - -- Field: Field6 - function Get_Component_Configuration (Target : Iir) return Iir; - procedure Set_Component_Configuration (Target : Iir; Conf : Iir); - - -- Configuration specification for a component_instantiation_statement. - -- Field: Field7 - function Get_Configuration_Specification (Target : Iir) return Iir; - procedure Set_Configuration_Specification (Target : Iir; Conf : Iir); - - -- Set/Get the default binding indication of a configuration specification - -- or a component configuration. - -- Field: Field5 - function Get_Default_Binding_Indication (Target : Iir) return Iir; - procedure Set_Default_Binding_Indication (Target : Iir; Conf : Iir); - - -- Set/Get the default configuration of an architecture. - -- Field: Field6 - function Get_Default_Configuration_Declaration (Target : Iir) return Iir; - procedure Set_Default_Configuration_Declaration (Target : Iir; Conf : Iir); - - -- Expression for an various nodes. - -- Field: Field5 - function Get_Expression (Target : Iir) return Iir; - procedure Set_Expression (Target : Iir; Expr : Iir); - - -- Set to the designated type (either the type of the expression or the - -- subtype) when the expression is analyzed. - -- Field: Field2 Ref - function Get_Allocator_Designated_Type (Target : Iir) return Iir; - procedure Set_Allocator_Designated_Type (Target : Iir; A_Type : Iir); - - -- Field: Field7 Chain - function Get_Selected_Waveform_Chain (Target : Iir) return Iir; - procedure Set_Selected_Waveform_Chain (Target : Iir; Chain : Iir); - - -- Field: Field7 Chain - function Get_Conditional_Waveform_Chain (Target : Iir) return Iir; - procedure Set_Conditional_Waveform_Chain (Target : Iir; Chain : Iir); - - -- Expression defining the value of the implicit guard signal. - -- Field: Field2 - function Get_Guard_Expression (Target : Iir) return Iir; - procedure Set_Guard_Expression (Target : Iir; Expr : Iir); - - -- The declaration (if any) of the implicit guard signal of a block - -- statement. - -- Field: Field8 - function Get_Guard_Decl (Target : Iir_Block_Statement) return Iir; - procedure Set_Guard_Decl (Target : Iir_Block_Statement; Decl : Iir); - - -- Sensitivity list for the implicit guard signal. - -- Field: Field6 (uc) - function Get_Guard_Sensitivity_List (Guard : Iir) return Iir_List; - procedure Set_Guard_Sensitivity_List (Guard : Iir; List : Iir_List); - - -- Block_Configuration that applies to this block statement. - -- Field: Field6 - function Get_Block_Block_Configuration (Block : Iir) return Iir; - procedure Set_Block_Block_Configuration (Block : Iir; Conf : Iir); - - -- Field: Field5 - function Get_Package_Header (Pkg : Iir) return Iir; - procedure Set_Package_Header (Pkg : Iir; Header : Iir); - - -- Field: Field7 - function Get_Block_Header (Target : Iir) return Iir; - procedure Set_Block_Header (Target : Iir; Header : Iir); - - -- Field: Field5 - function Get_Uninstantiated_Package_Name (Inst : Iir) return Iir; - procedure Set_Uninstantiated_Package_Name (Inst : Iir; Name : Iir); - - -- Get/Set the block_configuration (there may be several - -- block_configuration through the use of prev_configuration singly linked - -- list) that apply to this generate statement. - -- Field: Field7 - function Get_Generate_Block_Configuration (Target : Iir) return Iir; - procedure Set_Generate_Block_Configuration (Target : Iir; Conf : Iir); - - -- Field: Field6 - function Get_Generation_Scheme (Target : Iir) return Iir; - procedure Set_Generation_Scheme (Target : Iir; Scheme : Iir); - - -- Condition of a conditionam_waveform, if_statement, elsif, - -- while_loop_statement, next_statement or exit_statement. - -- Field: Field1 - function Get_Condition (Target : Iir) return Iir; - procedure Set_Condition (Target : Iir; Condition : Iir); - - -- Field: Field6 - function Get_Else_Clause (Target : Iir) return Iir; - procedure Set_Else_Clause (Target : Iir; Clause : Iir); - - -- Iterator of a for_loop_statement. - -- Field: Field1 - function Get_Parameter_Specification (Target : Iir) return Iir; - procedure Set_Parameter_Specification (Target : Iir; Param : Iir); - - -- Get/Set the statement in which TARGET appears. This is used to check - -- if next/exit is in a loop. - -- Field: Field0 Ref - function Get_Parent (Target : Iir) return Iir; - procedure Set_Parent (Target : Iir; Parent : Iir); - - -- Loop label for an exit_statement or next_statement. - -- Field: Field5 - function Get_Loop_Label (Target : Iir) return Iir; - procedure Set_Loop_Label (Target : Iir; Stmt : Iir); - - -- Component name for a component_configuration or - -- a configuration_specification. - -- Field: Field4 - function Get_Component_Name (Target : Iir) return Iir; - procedure Set_Component_Name (Target : Iir; Name : Iir); - - -- Field: Field1 (uc) - function Get_Instantiation_List (Target : Iir) return Iir_List; - procedure Set_Instantiation_List (Target : Iir; List : Iir_List); - - -- Field: Field3 - function Get_Entity_Aspect (Target : Iir_Binding_Indication) return Iir; - procedure Set_Entity_Aspect (Target : Iir_Binding_Indication; Entity : Iir); - - -- Field: Field1 - function Get_Default_Entity_Aspect (Target : Iir) return Iir; - procedure Set_Default_Entity_Aspect (Target : Iir; Aspect : Iir); - - -- Field: Field6 Chain - function Get_Default_Generic_Map_Aspect_Chain (Target : Iir) return Iir; - procedure Set_Default_Generic_Map_Aspect_Chain (Target : Iir; Chain : Iir); - - -- Field: Field7 Chain - function Get_Default_Port_Map_Aspect_Chain (Target : Iir) return Iir; - procedure Set_Default_Port_Map_Aspect_Chain (Target : Iir; Chain : Iir); - - -- Field: Field3 - function Get_Binding_Indication (Target : Iir) return Iir; - procedure Set_Binding_Indication (Target : Iir; Binding : Iir); - - -- The named entity designated by a name. - -- Field: Field4 Ref - function Get_Named_Entity (Name : Iir) return Iir; - procedure Set_Named_Entity (Name : Iir; Val : Iir); - - -- If a name designate a non-object alias, the designated alias. - -- Named_Entity will designate the aliased entity. - -- Field: Field2 - function Get_Alias_Declaration (Name : Iir) return Iir; - procedure Set_Alias_Declaration (Name : Iir; Val : Iir); - - -- Expression staticness, defined by rules of LRM 7.4 - -- Field: State1 (pos) - function Get_Expr_Staticness (Target : Iir) return Iir_Staticness; - procedure Set_Expr_Staticness (Target : Iir; Static : Iir_Staticness); - - -- Node which couldn't be correctly analyzed. - -- Field: Field2 - function Get_Error_Origin (Target : Iir) return Iir; - procedure Set_Error_Origin (Target : Iir; Origin : Iir); - - -- Operand of a monadic operator. - -- Field: Field2 - function Get_Operand (Target : Iir) return Iir; - procedure Set_Operand (Target : Iir; An_Iir : Iir); - - -- Left operand of a dyadic operator. - -- Field: Field2 - function Get_Left (Target : Iir) return Iir; - procedure Set_Left (Target : Iir; An_Iir : Iir); - - -- Right operand of a dyadic operator. - -- Field: Field4 - function Get_Right (Target : Iir) return Iir; - procedure Set_Right (Target : Iir; An_Iir : Iir); - - -- Field: Field3 - function Get_Unit_Name (Target : Iir) return Iir; - procedure Set_Unit_Name (Target : Iir; Name : Iir); - - -- Field: Field4 - function Get_Name (Target : Iir) return Iir; - procedure Set_Name (Target : Iir; Name : Iir); - - -- Field: Field5 - function Get_Group_Template_Name (Target : Iir) return Iir; - procedure Set_Group_Template_Name (Target : Iir; Name : Iir); - - -- Staticness of a name, according to rules of LRM 6.1 - -- Field: State2 (pos) - function Get_Name_Staticness (Target : Iir) return Iir_Staticness; - procedure Set_Name_Staticness (Target : Iir; Static : Iir_Staticness); - - -- Prefix of a name. - -- Field: Field0 - function Get_Prefix (Target : Iir) return Iir; - procedure Set_Prefix (Target : Iir; Prefix : Iir); - - -- Prefix of a name signature - -- Field: Field1 Ref - function Get_Signature_Prefix (Sign : Iir) return Iir; - procedure Set_Signature_Prefix (Sign : Iir; Prefix : Iir); - - -- The subtype of a slice. Contrary to the Type field, this is not a - -- reference. - -- Field: Field3 - function Get_Slice_Subtype (Slice : Iir) return Iir; - procedure Set_Slice_Subtype (Slice : Iir; Atype : Iir); - - -- Suffix of a slice or attribute. - -- Field: Field2 - function Get_Suffix (Target : Iir) return Iir; - procedure Set_Suffix (Target : Iir; Suffix : Iir); - - -- Set the designated index subtype of an array attribute. - -- Field: Field2 - function Get_Index_Subtype (Attr : Iir) return Iir; - procedure Set_Index_Subtype (Attr : Iir; St : Iir); - - -- Parameter of an attribute. - -- Field: Field4 - function Get_Parameter (Target : Iir) return Iir; - procedure Set_Parameter (Target : Iir; Param : Iir); - - -- Type of the actual for an association by individual. - -- Unless the formal is an unconstrained array type, this is the same as - -- the formal type. - -- Field: Field3 - function Get_Actual_Type (Target : Iir) return Iir; - procedure Set_Actual_Type (Target : Iir; Atype : Iir); - - -- Interface for a package association. - -- Field: Field4 Ref - function Get_Associated_Interface (Assoc : Iir) return Iir; - procedure Set_Associated_Interface (Assoc : Iir; Inter : Iir); - - -- List of individual associations for association_element_by_individual. - -- Associations for parenthesis_name. - -- Field: Field2 Chain - function Get_Association_Chain (Target : Iir) return Iir; - procedure Set_Association_Chain (Target : Iir; Chain : Iir); - - -- List of individual associations for association_element_by_individual. - -- Field: Field4 Chain - function Get_Individual_Association_Chain (Target : Iir) return Iir; - procedure Set_Individual_Association_Chain (Target : Iir; Chain : Iir); - - -- Get/Set info for the aggregate. - -- There is one aggregate_info for for each dimension. - -- Field: Field2 - function Get_Aggregate_Info (Target : Iir) return Iir; - procedure Set_Aggregate_Info (Target : Iir; Info : Iir); - - -- Get/Set the info node for the next dimension. - -- Field: Field1 - function Get_Sub_Aggregate_Info (Target : Iir) return Iir; - procedure Set_Sub_Aggregate_Info (Target : Iir; Info : Iir); - - -- TRUE when the length of the aggregate is not locally static. - -- Field: Flag3 - function Get_Aggr_Dynamic_Flag (Target : Iir) return Boolean; - procedure Set_Aggr_Dynamic_Flag (Target : Iir; Val : Boolean); - - -- Get/Set the minimum number of elements for the lowest dimension of - -- the aggregate or for the current dimension of a sub-aggregate. - -- The real number of elements may be greater than this number if there - -- is an 'other' choice. - -- Field: Field4 (uc) - function Get_Aggr_Min_Length (Info : Iir_Aggregate_Info) return Iir_Int32; - procedure Set_Aggr_Min_Length (Info : Iir_Aggregate_Info; Nbr : Iir_Int32); - - -- Highest index choice, if any. - -- Field: Field2 - function Get_Aggr_Low_Limit (Target : Iir_Aggregate_Info) return Iir; - procedure Set_Aggr_Low_Limit (Target : Iir_Aggregate_Info; Limit : Iir); - - -- Highest index choice, if any. - -- Field: Field3 - function Get_Aggr_High_Limit (Target : Iir_Aggregate_Info) return Iir; - procedure Set_Aggr_High_Limit (Target : Iir_Aggregate_Info; Limit : Iir); - - -- True if the aggregate has an 'others' choice. - -- Field: Flag2 - function Get_Aggr_Others_Flag (Target : Iir_Aggregate_Info) return Boolean; - procedure Set_Aggr_Others_Flag (Target : Iir_Aggregate_Info; Val : Boolean); - - -- True if the aggregate have named associations. - -- Field: Flag4 - function Get_Aggr_Named_Flag (Target : Iir_Aggregate_Info) return Boolean; - procedure Set_Aggr_Named_Flag (Target : Iir_Aggregate_Info; Val : Boolean); - - -- Staticness of the expressions in an aggregate. - -- We can't use expr_staticness for this purpose, since the staticness - -- of an aggregate is at most globally. - -- Field: State2 (pos) - function Get_Value_Staticness (Target : Iir) return Iir_Staticness; - procedure Set_Value_Staticness (Target : Iir; Staticness : Iir_Staticness); - - -- Chain of choices. - -- Field: Field4 Chain - function Get_Association_Choices_Chain (Target : Iir) return Iir; - procedure Set_Association_Choices_Chain (Target : Iir; Chain : Iir); - - -- Chain of choices. - -- Field: Field1 Chain - function Get_Case_Statement_Alternative_Chain (Target : Iir) return Iir; - procedure Set_Case_Statement_Alternative_Chain (Target : Iir; Chain : Iir); - - -- Staticness of the choice. - -- Field: State2 (pos) - function Get_Choice_Staticness (Target : Iir) return Iir_Staticness; - procedure Set_Choice_Staticness (Target : Iir; Staticness : Iir_Staticness); - - -- Field: Field1 - function Get_Procedure_Call (Stmt : Iir) return Iir; - procedure Set_Procedure_Call (Stmt : Iir; Call : Iir); - - -- Subprogram to be called by a procedure, function call or operator. This - -- is the declaration of the subprogram (or a list of during analysis). - -- Field: Field3 Ref - function Get_Implementation (Target : Iir) return Iir; - procedure Set_Implementation (Target : Iir; Decl : Iir); - - -- Paramater associations for procedure and function call. - -- Field: Field2 Chain - function Get_Parameter_Association_Chain (Target : Iir) return Iir; - procedure Set_Parameter_Association_Chain (Target : Iir; Chain : Iir); - - -- Object of a method call. NULL_IIR if the subprogram is not a method. - -- Field: Field4 - function Get_Method_Object (Target : Iir) return Iir; - procedure Set_Method_Object (Target : Iir; Object : Iir); - - -- The type_mark that appeared in the subtype indication. This is a name. - -- May be null_iir if there is no type mark (as in an iterator). - -- Field: Field2 - function Get_Subtype_Type_Mark (Target : Iir) return Iir; - procedure Set_Subtype_Type_Mark (Target : Iir; Mark : Iir); - - -- Field: Field3 - function Get_Type_Conversion_Subtype (Target : Iir) return Iir; - procedure Set_Type_Conversion_Subtype (Target : Iir; Atype : Iir); - - -- The type_mark that appeared in qualified expressions or type - -- conversions. - -- Field: Field4 - function Get_Type_Mark (Target : Iir) return Iir; - procedure Set_Type_Mark (Target : Iir; Mark : Iir); - - -- The type of values for a type file. - -- Field: Field2 - function Get_File_Type_Mark (Target : Iir) return Iir; - procedure Set_File_Type_Mark (Target : Iir; Mark : Iir); - - -- Field: Field8 - function Get_Return_Type_Mark (Target : Iir) return Iir; - procedure Set_Return_Type_Mark (Target : Iir; Mark : Iir); - - -- Get/set the lexical layout of an interface. - -- Field: Odigit2 (pos) - function Get_Lexical_Layout (Decl : Iir) return Iir_Lexical_Layout_Type; - procedure Set_Lexical_Layout (Decl : Iir; Lay : Iir_Lexical_Layout_Type); - - -- List of use (designated type of access types) of an incomplete type - -- definition. The purpose is to complete the uses with the full type - -- definition. - -- Field: Field2 (uc) - function Get_Incomplete_Type_List (Target : Iir) return Iir_List; - procedure Set_Incomplete_Type_List (Target : Iir; List : Iir_List); - - -- This flag is set on a signal_declaration, when a disconnection - -- specification applies to the signal (or a subelement of it). - -- This is used to check 'others' and 'all' designators. - -- Field: Flag1 - function Get_Has_Disconnect_Flag (Target : Iir) return Boolean; - procedure Set_Has_Disconnect_Flag (Target : Iir; Val : Boolean); - - -- This flag is set on a signal when its activity is read by the user. - -- Some signals handling can be optimized when this flag is set. - -- Field: Flag2 - function Get_Has_Active_Flag (Target : Iir) return Boolean; - procedure Set_Has_Active_Flag (Target : Iir; Val : Boolean); - - -- This flag is set is code being analyzed is textually within TARGET. - -- This is used for selected by name rule. - -- Field: Flag5 - function Get_Is_Within_Flag (Target : Iir) return Boolean; - procedure Set_Is_Within_Flag (Target : Iir; Val : Boolean); - - -- List of type_mark for an Iir_Kind_Signature - -- Field: Field2 (uc) - function Get_Type_Marks_List (Target : Iir) return Iir_List; - procedure Set_Type_Marks_List (Target : Iir; List : Iir_List); - - -- Field: Flag1 - function Get_Implicit_Alias_Flag (Decl : Iir) return Boolean; - procedure Set_Implicit_Alias_Flag (Decl : Iir; Flag : Boolean); - - -- Field: Field5 - function Get_Alias_Signature (Alias : Iir) return Iir; - procedure Set_Alias_Signature (Alias : Iir; Signature : Iir); - - -- Field: Field2 - function Get_Attribute_Signature (Attr : Iir) return Iir; - procedure Set_Attribute_Signature (Attr : Iir; Signature : Iir); - - -- Field: Field1 Of_Ref (uc) - function Get_Overload_List (Target : Iir) return Iir_List; - procedure Set_Overload_List (Target : Iir; List : Iir_List); - - -- Identifier of the simple_name attribute. - -- Field: Field3 (uc) - function Get_Simple_Name_Identifier (Target : Iir) return Name_Id; - procedure Set_Simple_Name_Identifier (Target : Iir; Ident : Name_Id); - - -- Subtype for Simple_Name attribute. - -- Field: Field4 - function Get_Simple_Name_Subtype (Target : Iir) return Iir; - procedure Set_Simple_Name_Subtype (Target : Iir; Atype : Iir); - - -- Body of a protected type declaration. - -- Field: Field2 - function Get_Protected_Type_Body (Target : Iir) return Iir; - procedure Set_Protected_Type_Body (Target : Iir; Bod : Iir); - - -- Corresponsing protected type declaration of a protected type body. - -- Field: Field4 - function Get_Protected_Type_Declaration (Target : Iir) return Iir; - procedure Set_Protected_Type_Declaration (Target : Iir; Decl : Iir); - - -- Location of the 'end' token. - -- Field: Field6 (uc) - function Get_End_Location (Target : Iir) return Location_Type; - procedure Set_End_Location (Target : Iir; Loc : Location_Type); - - -- For a string literal: the string identifier. - -- Field: Field3 (uc) - function Get_String_Id (Lit : Iir) return String_Id; - procedure Set_String_Id (Lit : Iir; Id : String_Id); - - -- For a string literal: the string length. - -- Field: Field4 (uc) - function Get_String_Length (Lit : Iir) return Int32; - procedure Set_String_Length (Lit : Iir; Len : Int32); - - -- For a declaration: true if the declaration is used somewhere. - -- Field: Flag6 - function Get_Use_Flag (Decl : Iir) return Boolean; - procedure Set_Use_Flag (Decl : Iir; Val : Boolean); - - -- Layout flag: true if 'end' is followed by the reserved identifier. - -- Field: Flag8 - function Get_End_Has_Reserved_Id (Decl : Iir) return Boolean; - procedure Set_End_Has_Reserved_Id (Decl : Iir; Flag : Boolean); - - -- Layout flag: true if 'end' is followed by the identifier. - -- Field: Flag9 - function Get_End_Has_Identifier (Decl : Iir) return Boolean; - procedure Set_End_Has_Identifier (Decl : Iir; Flag : Boolean); - - -- Layout flag: true if 'end' is followed by 'postponed'. - -- Field: Flag10 - function Get_End_Has_Postponed (Decl : Iir) return Boolean; - procedure Set_End_Has_Postponed (Decl : Iir; Flag : Boolean); - - -- Layout flag: true if 'begin' is present. - -- Field: Flag10 - function Get_Has_Begin (Decl : Iir) return Boolean; - procedure Set_Has_Begin (Decl : Iir; Flag : Boolean); - - -- Layout flag: true if 'is' is present. - -- Field: Flag7 - function Get_Has_Is (Decl : Iir) return Boolean; - procedure Set_Has_Is (Decl : Iir; Flag : Boolean); - - -- Layout flag: true if 'pure' or 'impure' is present. - -- Field: Flag8 - function Get_Has_Pure (Decl : Iir) return Boolean; - procedure Set_Has_Pure (Decl : Iir; Flag : Boolean); - - -- Layout flag: true if body appears just after the specification. - -- Field: Flag9 - function Get_Has_Body (Decl : Iir) return Boolean; - procedure Set_Has_Body (Decl : Iir; Flag : Boolean); - - -- Layout flag for object declaration. If True, the identifier of this - -- declaration is followed by an identifier (and separated by a comma). - -- This flag is set on all but the last declarations. - -- Eg: on 'signal A, B, C : Bit', the flag is set on A and B (but not C). - -- Field: Flag3 - function Get_Has_Identifier_List (Decl : Iir) return Boolean; - procedure Set_Has_Identifier_List (Decl : Iir; Flag : Boolean); - - -- Layout flag for object declaration. If True, the mode is present. - -- Field: Flag8 - function Get_Has_Mode (Decl : Iir) return Boolean; - procedure Set_Has_Mode (Decl : Iir; Flag : Boolean); - - -- Set to True if Maybe_Ref fields are references. This cannot be shared - -- with Has_Identifier_List as: Is_Ref is set to True on all items but - -- the first, while Has_Identifier_List is set to True on all items but - -- the last. Furthermore Is_Ref appears in nodes where Has_Identifier_List - -- is not present. - -- Field: Flag7 - function Get_Is_Ref (N : Iir) return Boolean; - procedure Set_Is_Ref (N : Iir; Ref : Boolean); - - -- Field: Field1 (uc) - function Get_Psl_Property (Decl : Iir) return PSL_Node; - procedure Set_Psl_Property (Decl : Iir; Prop : PSL_Node); - - -- Field: Field1 (uc) - function Get_Psl_Declaration (Decl : Iir) return PSL_Node; - procedure Set_Psl_Declaration (Decl : Iir; Prop : PSL_Node); - - -- Field: Field3 (uc) - function Get_Psl_Expression (Decl : Iir) return PSL_Node; - procedure Set_Psl_Expression (Decl : Iir; Prop : PSL_Node); - - -- Field: Field1 (uc) - function Get_Psl_Boolean (N : Iir) return PSL_Node; - procedure Set_Psl_Boolean (N : Iir; Bool : PSL_Node); - - -- Field: Field7 (uc) - function Get_PSL_Clock (N : Iir) return PSL_Node; - procedure Set_PSL_Clock (N : Iir; Clock : PSL_Node); - - -- Field: Field8 (uc) - function Get_PSL_NFA (N : Iir) return PSL_NFA; - procedure Set_PSL_NFA (N : Iir; Fa : PSL_NFA); -end Iirs; diff --git a/iirs_utils.adb b/iirs_utils.adb deleted file mode 100644 index 52c1ee8bb..000000000 --- a/iirs_utils.adb +++ /dev/null @@ -1,1131 +0,0 @@ --- Common operations on nodes. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Scanner; use Scanner; -with Tokens; use Tokens; -with Errorout; use Errorout; -with Name_Table; -with Str_Table; -with Std_Names; use Std_Names; -with Flags; use Flags; -with PSL.Nodes; -with Sem_Inst; - -package body Iirs_Utils is - -- Transform the current token into an iir literal. - -- The current token must be either a character or an identifier. - function Current_Text return Iir is - Res: Iir; - begin - case Current_Token is - when Tok_Identifier => - Res := Create_Iir (Iir_Kind_Simple_Name); - when Tok_Character => - Res := Create_Iir (Iir_Kind_Character_Literal); - when others => - raise Internal_Error; - end case; - Set_Identifier (Res, Current_Identifier); - Invalidate_Current_Identifier; - Invalidate_Current_Token; - Set_Location (Res, Get_Token_Location); - return Res; - end Current_Text; - - function Is_Error (N : Iir) return Boolean is - begin - return Get_Kind (N) = Iir_Kind_Error; - end Is_Error; - - function Get_Operator_Name (Op : Iir) return Name_Id is - begin - case Get_Kind (Op) is - when Iir_Kind_And_Operator - | Iir_Kind_Reduction_And_Operator => - return Name_And; - when Iir_Kind_Or_Operator - | Iir_Kind_Reduction_Or_Operator => - return Name_Or; - when Iir_Kind_Nand_Operator - | Iir_Kind_Reduction_Nand_Operator => - return Name_Nand; - when Iir_Kind_Nor_Operator - | Iir_Kind_Reduction_Nor_Operator => - return Name_Nor; - when Iir_Kind_Xor_Operator - | Iir_Kind_Reduction_Xor_Operator => - return Name_Xor; - when Iir_Kind_Xnor_Operator - | Iir_Kind_Reduction_Xnor_Operator => - return Name_Xnor; - - when Iir_Kind_Equality_Operator => - return Name_Op_Equality; - when Iir_Kind_Inequality_Operator => - return Name_Op_Inequality; - when Iir_Kind_Less_Than_Operator => - return Name_Op_Less; - when Iir_Kind_Less_Than_Or_Equal_Operator => - return Name_Op_Less_Equal; - when Iir_Kind_Greater_Than_Operator => - return Name_Op_Greater; - when Iir_Kind_Greater_Than_Or_Equal_Operator => - return Name_Op_Greater_Equal; - - when Iir_Kind_Match_Equality_Operator => - return Name_Op_Match_Equality; - when Iir_Kind_Match_Inequality_Operator => - return Name_Op_Match_Inequality; - when Iir_Kind_Match_Less_Than_Operator => - return Name_Op_Match_Less; - when Iir_Kind_Match_Less_Than_Or_Equal_Operator => - return Name_Op_Match_Less_Equal; - when Iir_Kind_Match_Greater_Than_Operator => - return Name_Op_Match_Greater; - when Iir_Kind_Match_Greater_Than_Or_Equal_Operator => - return Name_Op_Match_Greater_Equal; - - when Iir_Kind_Sll_Operator => - return Name_Sll; - when Iir_Kind_Sla_Operator => - return Name_Sla; - when Iir_Kind_Srl_Operator => - return Name_Srl; - when Iir_Kind_Sra_Operator => - return Name_Sra; - when Iir_Kind_Rol_Operator => - return Name_Rol; - when Iir_Kind_Ror_Operator => - return Name_Ror; - when Iir_Kind_Addition_Operator => - return Name_Op_Plus; - when Iir_Kind_Substraction_Operator => - return Name_Op_Minus; - when Iir_Kind_Concatenation_Operator => - return Name_Op_Concatenation; - when Iir_Kind_Multiplication_Operator => - return Name_Op_Mul; - when Iir_Kind_Division_Operator => - return Name_Op_Div; - when Iir_Kind_Modulus_Operator => - return Name_Mod; - when Iir_Kind_Remainder_Operator => - return Name_Rem; - when Iir_Kind_Exponentiation_Operator => - return Name_Op_Exp; - when Iir_Kind_Not_Operator => - return Name_Not; - when Iir_Kind_Negation_Operator => - return Name_Op_Minus; - when Iir_Kind_Identity_Operator => - return Name_Op_Plus; - when Iir_Kind_Absolute_Operator => - return Name_Abs; - when Iir_Kind_Condition_Operator => - return Name_Op_Condition; - when others => - raise Internal_Error; - end case; - end Get_Operator_Name; - - function Get_Longuest_Static_Prefix (Expr: Iir) return Iir is - Adecl: Iir; - begin - Adecl := Expr; - loop - case Get_Kind (Adecl) is - when Iir_Kind_Variable_Declaration - | Iir_Kind_Interface_Variable_Declaration => - return Adecl; - when Iir_Kind_Constant_Declaration - | Iir_Kind_Interface_Constant_Declaration => - return Adecl; - when Iir_Kind_Signal_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Interface_Signal_Declaration => - return Adecl; - when Iir_Kind_Object_Alias_Declaration => - -- LRM 4.3.3.1 Object Aliases - -- 2. The name must be a static name [...] - return Adecl; - when Iir_Kind_Slice_Name - | Iir_Kind_Indexed_Name - | Iir_Kind_Selected_Element => - if Get_Name_Staticness (Adecl) >= Globally then - return Adecl; - else - Adecl := Get_Prefix (Adecl); - end if; - when Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name => - Adecl := Get_Named_Entity (Adecl); - when Iir_Kind_Type_Conversion => - return Null_Iir; - when others => - Error_Kind ("get_longuest_static_prefix", Adecl); - end case; - end loop; - end Get_Longuest_Static_Prefix; - - function Get_Object_Prefix (Name: Iir; With_Alias : Boolean := True) - return Iir - is - Adecl : Iir; - begin - Adecl := Name; - loop - case Get_Kind (Adecl) is - when Iir_Kind_Variable_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Iterator_Declaration => - return Adecl; - when Iir_Kind_Object_Alias_Declaration => - if With_Alias then - Adecl := Get_Name (Adecl); - else - return Adecl; - end if; - when Iir_Kind_Indexed_Name - | Iir_Kind_Slice_Name - | Iir_Kind_Selected_Element - | Iir_Kind_Selected_By_All_Name => - Adecl := Get_Base_Name (Adecl); - when Iir_Kinds_Literal - | Iir_Kind_Enumeration_Literal - | Iir_Kinds_Monadic_Operator - | Iir_Kinds_Dyadic_Operator - | Iir_Kind_Function_Call - | Iir_Kind_Qualified_Expression - | Iir_Kind_Type_Conversion - | Iir_Kind_Allocator_By_Expression - | Iir_Kind_Allocator_By_Subtype - | Iir_Kinds_Attribute - | Iir_Kind_Attribute_Value - | Iir_Kind_Aggregate - | Iir_Kind_Simple_Aggregate - | Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference - | Iir_Kind_Unit_Declaration - | Iir_Kinds_Concurrent_Statement => - return Adecl; - when Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name => - Adecl := Get_Named_Entity (Adecl); - when Iir_Kind_Attribute_Name => - return Get_Named_Entity (Adecl); - when others => - Error_Kind ("get_object_prefix", Adecl); - end case; - end loop; - end Get_Object_Prefix; - - function Get_Association_Interface (Assoc : Iir) return Iir - is - Formal : Iir; - begin - Formal := Get_Formal (Assoc); - loop - case Get_Kind (Formal) is - when Iir_Kind_Simple_Name => - return Get_Named_Entity (Formal); - when Iir_Kinds_Interface_Object_Declaration => - return Formal; - when Iir_Kind_Slice_Name - | Iir_Kind_Indexed_Name - | Iir_Kind_Selected_Element => - Formal := Get_Prefix (Formal); - when others => - Error_Kind ("get_association_interface", Formal); - end case; - end loop; - end Get_Association_Interface; - - function Find_Name_In_List (List: Iir_List; Lit: Name_Id) return Iir is - El: Iir; - Ident: Name_Id; - begin - for I in Natural loop - El := Get_Nth_Element (List, I); - exit when El = Null_Iir; - Ident := Get_Identifier (El); - if Ident = Lit then - return El; - end if; - end loop; - return Null_Iir; - end Find_Name_In_List; - - function Find_Name_In_Chain (Chain: Iir; Lit: Name_Id) return Iir - is - El: Iir := Chain; - begin - while El /= Null_Iir loop - if Get_Identifier (El) = Lit then - return El; - end if; - El := Get_Chain (El); - end loop; - return Null_Iir; - end Find_Name_In_Chain; - - function Is_In_Chain (Chain : Iir; El : Iir) return Boolean - is - Chain_El : Iir; - begin - Chain_El := Chain; - while Chain_El /= Null_Iir loop - if Chain_El = El then - return True; - end if; - Chain_El := Get_Chain (Chain_El); - end loop; - return False; - end Is_In_Chain; - - procedure Add_Dependence (Target: Iir_Design_Unit; Unit: Iir) is - begin - -- Do not add self-dependency - if Unit = Target then - return; - end if; - - case Get_Kind (Unit) is - when Iir_Kind_Design_Unit - | Iir_Kind_Entity_Aspect_Entity => - null; - when others => - Error_Kind ("add_dependence", Unit); - end case; - - Add_Element (Get_Dependence_List (Target), Unit); - end Add_Dependence; - - procedure Clear_Instantiation_Configuration_Vhdl87 - (Parent : Iir; In_Generate : Boolean; Full : Boolean) - is - El : Iir; - Prev : Iir; - begin - El := Get_Concurrent_Statement_Chain (Parent); - while El /= Null_Iir loop - case Get_Kind (El) is - when Iir_Kind_Component_Instantiation_Statement => - if In_Generate and not Full then - Prev := Get_Component_Configuration (El); - if Prev /= Null_Iir then - case Get_Kind (Prev) is - when Iir_Kind_Configuration_Specification => - -- Keep it. - null; - when Iir_Kind_Component_Configuration => - Set_Component_Configuration (El, Null_Iir); - when others => - Error_Kind - ("clear_instantiation_configuration_vhdl87", - Prev); - end case; - end if; - else - Set_Component_Configuration (El, Null_Iir); - end if; - when Iir_Kind_Generate_Statement => - Set_Generate_Block_Configuration (El, Null_Iir); - -- Clear inside a generate statement. - Clear_Instantiation_Configuration_Vhdl87 (El, True, Full); - when Iir_Kind_Block_Statement => - Set_Block_Block_Configuration (El, Null_Iir); - when others => - null; - end case; - El := Get_Chain (El); - end loop; - end Clear_Instantiation_Configuration_Vhdl87; - - procedure Clear_Instantiation_Configuration (Parent : Iir; Full : Boolean) - is - El : Iir; - begin - if False and then Flags.Vhdl_Std = Vhdl_87 then - Clear_Instantiation_Configuration_Vhdl87 - (Parent, Get_Kind (Parent) = Iir_Kind_Generate_Statement, Full); - else - El := Get_Concurrent_Statement_Chain (Parent); - while El /= Null_Iir loop - case Get_Kind (El) is - when Iir_Kind_Component_Instantiation_Statement => - Set_Component_Configuration (El, Null_Iir); - when Iir_Kind_Generate_Statement => - Set_Generate_Block_Configuration (El, Null_Iir); - when Iir_Kind_Block_Statement => - Set_Block_Block_Configuration (El, Null_Iir); - when others => - null; - end case; - El := Get_Chain (El); - end loop; - end if; - end Clear_Instantiation_Configuration; - - function Get_String_Fat_Acc (Str : Iir) return String_Fat_Acc is - begin - return Str_Table.Get_String_Fat_Acc (Get_String_Id (Str)); - end Get_String_Fat_Acc; - - -- Get identifier of NODE as a string. - function Image_Identifier (Node : Iir) return String is - begin - return Name_Table.Image (Iirs.Get_Identifier (Node)); - end Image_Identifier; - - function Image_String_Lit (Str : Iir) return String - is - Ptr : String_Fat_Acc; - Len : Nat32; - begin - Ptr := Get_String_Fat_Acc (Str); - Len := Get_String_Length (Str); - return String (Ptr (1 .. Len)); - end Image_String_Lit; - - function Copy_Enumeration_Literal (Lit : Iir) return Iir - is - Res : Iir; - begin - Res := Create_Iir (Iir_Kind_Enumeration_Literal); - Set_Identifier (Res, Get_Identifier (Lit)); - Location_Copy (Res, Lit); - Set_Parent (Res, Get_Parent (Lit)); - Set_Type (Res, Get_Type (Lit)); - Set_Enum_Pos (Res, Get_Enum_Pos (Lit)); - Set_Expr_Staticness (Res, Locally); - Set_Enumeration_Decl (Res, Lit); - return Res; - end Copy_Enumeration_Literal; - - procedure Create_Range_Constraint_For_Enumeration_Type - (Def : Iir_Enumeration_Type_Definition) - is - Range_Expr : Iir_Range_Expression; - Literal_List : constant Iir_List := Get_Enumeration_Literal_List (Def); - begin - -- Create a constraint. - Range_Expr := Create_Iir (Iir_Kind_Range_Expression); - Location_Copy (Range_Expr, Def); - Set_Type (Range_Expr, Def); - Set_Direction (Range_Expr, Iir_To); - Set_Left_Limit - (Range_Expr, - Copy_Enumeration_Literal (Get_First_Element (Literal_List))); - Set_Right_Limit - (Range_Expr, - Copy_Enumeration_Literal (Get_Last_Element (Literal_List))); - Set_Expr_Staticness (Range_Expr, Locally); - Set_Range_Constraint (Def, Range_Expr); - end Create_Range_Constraint_For_Enumeration_Type; - - procedure Free_Name (Node : Iir) - is - N : Iir; - N1 : Iir; - begin - if Node = Null_Iir then - return; - end if; - N := Node; - case Get_Kind (N) is - when Iir_Kind_Simple_Name - | Iir_Kind_Character_Literal - | Iir_Kind_String_Literal - | Iir_Kind_Subtype_Definition => - Free_Iir (N); - when Iir_Kind_Selected_Name - | Iir_Kind_Parenthesis_Name - | Iir_Kind_Selected_By_All_Name => - N1 := Get_Prefix (N); - Free_Iir (N); - Free_Name (N1); - when Iir_Kind_Library_Declaration - | Iir_Kind_Package_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Design_Unit - | Iir_Kinds_Concurrent_Statement - | Iir_Kinds_Sequential_Statement => - return; - when others => - Error_Kind ("free_name", Node); - --Free_Iir (N); - end case; - end Free_Name; - - procedure Free_Recursive_List (List : Iir_List) - is - El : Iir; - begin - for I in Natural loop - El := Get_Nth_Element (List, I); - exit when El = Null_Iir; - Free_Recursive (El); - end loop; - end Free_Recursive_List; - - procedure Free_Recursive (Node : Iir; Free_List : Boolean := False) - is - N : Iir; - begin - if Node = Null_Iir then - return; - end if; - N := Node; - case Get_Kind (N) is - when Iir_Kind_Library_Declaration => - return; - when Iir_Kind_Simple_Name - | Iir_Kind_Parenthesis_Name - | Iir_Kind_Character_Literal => - null; - when Iir_Kind_Enumeration_Literal => - return; - when Iir_Kind_Selected_Name => - Free_Recursive (Get_Prefix (N)); - when Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration => - Free_Recursive (Get_Type (N)); - Free_Recursive (Get_Default_Value (N)); - when Iir_Kind_Range_Expression => - Free_Recursive (Get_Left_Limit (N)); - Free_Recursive (Get_Right_Limit (N)); - when Iir_Kind_Subtype_Definition => - Free_Recursive (Get_Base_Type (N)); - when Iir_Kind_Integer_Literal => - null; - when Iir_Kind_Package_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Entity_Declaration - | Iir_Kind_Configuration_Declaration => - null; - when Iir_Kind_File_Type_Definition - | Iir_Kind_Access_Type_Definition - | Iir_Kind_Array_Type_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition => - return; - when Iir_Kind_Architecture_Body => - Free_Recursive (Get_Entity_Name (N)); - when Iir_Kind_Overload_List => - Free_Recursive_List (Get_Overload_List (N)); - if not Free_List then - return; - end if; - when Iir_Kind_Array_Subtype_Definition => - Free_Recursive_List (Get_Index_List (N)); - Free_Recursive (Get_Base_Type (N)); - when Iir_Kind_Entity_Aspect_Entity => - Free_Recursive (Get_Entity (N)); - Free_Recursive (Get_Architecture (N)); - when others => - Error_Kind ("free_recursive", Node); - end case; - Free_Iir (N); - end Free_Recursive; - - function Get_Predefined_Function_Name (Func : Iir_Predefined_Functions) - return String - is - begin - return Iir_Predefined_Functions'Image (Func); - end Get_Predefined_Function_Name; - - procedure Mark_Subprogram_Used (Subprg : Iir) - is - N : Iir; - begin - N := Subprg; - loop - exit when Get_Use_Flag (N); - Set_Use_Flag (N, True); - N := Sem_Inst.Get_Origin (N); - -- The origin may also be an instance. - exit when N = Null_Iir; - end loop; - end Mark_Subprogram_Used; - - function Get_Callees_List_Holder (Subprg : Iir) return Iir is - begin - case Get_Kind (Subprg) is - when Iir_Kind_Procedure_Declaration - | Iir_Kind_Function_Declaration => - return Get_Subprogram_Body (Subprg); - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - return Subprg; - when others => - Error_Kind ("get_callees_list_holder", Subprg); - end case; - end Get_Callees_List_Holder; - - procedure Clear_Seen_Flag (Top : Iir) - is - Callees_List : Iir_Callees_List; - El: Iir; - begin - if Get_Seen_Flag (Top) then - Set_Seen_Flag (Top, False); - Callees_List := Get_Callees_List (Get_Callees_List_Holder (Top)); - if Callees_List /= Null_Iir_List then - for I in Natural loop - El := Get_Nth_Element (Callees_List, I); - exit when El = Null_Iir; - if Get_Seen_Flag (El) = False then - Clear_Seen_Flag (El); - end if; - end loop; - end if; - end if; - end Clear_Seen_Flag; - - function Is_Anonymous_Type_Definition (Def : Iir) return Boolean is - begin - return Get_Type_Declarator (Def) = Null_Iir; - end Is_Anonymous_Type_Definition; - - function Is_Fully_Constrained_Type (Def : Iir) return Boolean is - begin - return Get_Kind (Def) not in Iir_Kinds_Composite_Type_Definition - or else Get_Constraint_State (Def) = Fully_Constrained; - end Is_Fully_Constrained_Type; - - function Strip_Denoting_Name (Name : Iir) return Iir is - begin - if Get_Kind (Name) in Iir_Kinds_Denoting_Name then - return Get_Named_Entity (Name); - else - return Name; - end if; - end Strip_Denoting_Name; - - function Build_Simple_Name (Ref : Iir; Loc : Location_Type) return Iir - is - Res : Iir; - begin - Res := Create_Iir (Iir_Kind_Simple_Name); - Set_Location (Res, Loc); - Set_Identifier (Res, Get_Identifier (Ref)); - Set_Named_Entity (Res, Ref); - Set_Base_Name (Res, Res); - -- FIXME: set type and expr staticness ? - return Res; - end Build_Simple_Name; - - function Build_Simple_Name (Ref : Iir; Loc : Iir) return Iir is - begin - return Build_Simple_Name (Ref, Get_Location (Loc)); - end Build_Simple_Name; - - function Has_Resolution_Function (Subtyp : Iir) return Iir - is - Ind : constant Iir := Get_Resolution_Indication (Subtyp); - begin - if Ind /= Null_Iir - and then Get_Kind (Ind) in Iir_Kinds_Denoting_Name - then - return Get_Named_Entity (Ind); - else - return Null_Iir; - end if; - end Has_Resolution_Function; - - function Get_Primary_Unit_Name (Physical_Def : Iir) return Iir - is - Unit : constant Iir := Get_Primary_Unit (Physical_Def); - begin - return Get_Unit_Name (Get_Physical_Unit_Value (Unit)); - end Get_Primary_Unit_Name; - - function Is_Type_Name (Name : Iir) return Iir - is - Ent : Iir; - begin - if Get_Kind (Name) in Iir_Kinds_Denoting_Name then - Ent := Get_Named_Entity (Name); - case Get_Kind (Ent) is - when Iir_Kind_Type_Declaration => - return Get_Type_Definition (Ent); - when Iir_Kind_Subtype_Declaration - | Iir_Kind_Base_Attribute => - return Get_Type (Ent); - when others => - return Null_Iir; - end case; - else - return Null_Iir; - end if; - end Is_Type_Name; - - function Get_Type_Of_Subtype_Indication (Ind : Iir) return Iir is - begin - case Get_Kind (Ind) is - when Iir_Kinds_Denoting_Name => - return Get_Type (Ind); - when Iir_Kinds_Subtype_Definition => - return Ind; - when others => - Error_Kind ("get_type_of_subtype_indication", Ind); - end case; - end Get_Type_Of_Subtype_Indication; - - function Get_Index_Type (Indexes : Iir_List; Idx : Natural) return Iir - is - Index : constant Iir := Get_Nth_Element (Indexes, Idx); - begin - if Index = Null_Iir then - return Null_Iir; - else - return Get_Index_Type (Index); - end if; - end Get_Index_Type; - - function Get_Index_Type (Array_Type : Iir; Idx : Natural) return Iir is - begin - return Get_Index_Type (Get_Index_Subtype_List (Array_Type), Idx); - end Get_Index_Type; - - function Get_Denoted_Type_Mark (Subtyp : Iir) return Iir - is - Type_Mark_Name : constant Iir := Get_Subtype_Type_Mark (Subtyp); - begin - if Type_Mark_Name = Null_Iir then - -- No type_mark (for array subtype created by constrained array - -- definition. - return Null_Iir; - else - return Get_Type (Get_Named_Entity (Type_Mark_Name)); - end if; - end Get_Denoted_Type_Mark; - - function Is_Second_Subprogram_Specification (Spec : Iir) return Boolean - is - Bod : constant Iir := Get_Subprogram_Body (Spec); - begin - return Bod /= Null_Iir - and then Get_Subprogram_Specification (Bod) /= Spec; - end Is_Second_Subprogram_Specification; - - function Is_Same_Profile (L, R: Iir) return Boolean - is - L1, R1 : Iir; - L_Kind, R_Kind : Iir_Kind; - El_L, El_R : Iir; - begin - L_Kind := Get_Kind (L); - if L_Kind = Iir_Kind_Non_Object_Alias_Declaration then - L1 := Get_Named_Entity (Get_Name (L)); - L_Kind := Get_Kind (L1); - else - L1 := L; - end if; - R_Kind := Get_Kind (R); - if R_Kind = Iir_Kind_Non_Object_Alias_Declaration then - R1 := Get_Named_Entity (Get_Name (R)); - R_Kind := Get_Kind (R1); - else - R1 := R; - end if; - - -- Check L and R are both of the same 'kind'. - -- Also the return profile for functions. - if L_Kind in Iir_Kinds_Function_Declaration - and then R_Kind in Iir_Kinds_Function_Declaration - then - if Get_Base_Type (Get_Return_Type (L1)) /= - Get_Base_Type (Get_Return_Type (R1)) - then - return False; - end if; - elsif L_Kind in Iir_Kinds_Procedure_Declaration - and then R_Kind in Iir_Kinds_Procedure_Declaration - then - null; - elsif L_Kind = Iir_Kind_Enumeration_Literal - and then R_Kind = Iir_Kind_Enumeration_Literal - then - return Get_Type (L1) = Get_Type (R1); - else - -- Kind mismatch. - return False; - end if; - - -- Check parameters profile. - El_L := Get_Interface_Declaration_Chain (L1); - El_R := Get_Interface_Declaration_Chain (R1); - loop - exit when El_L = Null_Iir and El_R = Null_Iir; - if El_L = Null_Iir or El_R = Null_Iir then - return False; - end if; - if Get_Base_Type (Get_Type (El_L)) /= Get_Base_Type (Get_Type (El_R)) - then - return False; - end if; - El_L := Get_Chain (El_L); - El_R := Get_Chain (El_R); - end loop; - - return True; - end Is_Same_Profile; - - -- From a block_specification, returns the block. - function Get_Block_From_Block_Specification (Block_Spec : Iir) - return Iir - is - Res : Iir; - begin - case Get_Kind (Block_Spec) is - when Iir_Kind_Design_Unit => - Res := Get_Library_Unit (Block_Spec); - if Get_Kind (Res) /= Iir_Kind_Architecture_Body then - raise Internal_Error; - end if; - return Res; - when Iir_Kind_Block_Statement - | Iir_Kind_Architecture_Body - | Iir_Kind_Generate_Statement => - return Block_Spec; - when Iir_Kind_Indexed_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Slice_Name => - return Get_Named_Entity (Get_Prefix (Block_Spec)); - when Iir_Kind_Simple_Name => - return Get_Named_Entity (Block_Spec); - when others => - Error_Kind ("get_block_from_block_specification", Block_Spec); - return Null_Iir; - end case; - end Get_Block_From_Block_Specification; - - function Get_Entity (Decl : Iir) return Iir - is - Name : constant Iir := Get_Entity_Name (Decl); - Res : constant Iir := Get_Named_Entity (Name); - begin - pragma Assert (Res = Null_Iir - or else Get_Kind (Res) = Iir_Kind_Entity_Declaration); - return Res; - end Get_Entity; - - function Get_Configuration (Aspect : Iir) return Iir - is - Name : constant Iir := Get_Configuration_Name (Aspect); - Res : constant Iir := Get_Named_Entity (Name); - begin - pragma Assert (Get_Kind (Res) = Iir_Kind_Configuration_Declaration); - return Res; - end Get_Configuration; - - function Get_Entity_Identifier_Of_Architecture (Arch : Iir) return Name_Id - is - Name : constant Iir := Get_Entity_Name (Arch); - begin - case Get_Kind (Name) is - when Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name => - return Get_Identifier (Name); - when others => - Error_Kind ("get_entity_identifier_of_architecture", Name); - end case; - end Get_Entity_Identifier_Of_Architecture; - - function Is_Component_Instantiation - (Inst : Iir_Component_Instantiation_Statement) - return Boolean is - begin - case Get_Kind (Get_Instantiated_Unit (Inst)) is - when Iir_Kinds_Denoting_Name => - return True; - when Iir_Kind_Entity_Aspect_Entity - | Iir_Kind_Entity_Aspect_Configuration => - return False; - when others => - Error_Kind ("is_component_instantiation", Inst); - end case; - end Is_Component_Instantiation; - - function Is_Entity_Instantiation - (Inst : Iir_Component_Instantiation_Statement) - return Boolean is - begin - case Get_Kind (Get_Instantiated_Unit (Inst)) is - when Iir_Kinds_Denoting_Name => - return False; - when Iir_Kind_Entity_Aspect_Entity - | Iir_Kind_Entity_Aspect_Configuration => - return True; - when others => - Error_Kind ("is_entity_instantiation", Inst); - end case; - end Is_Entity_Instantiation; - - function Get_String_Type_Bound_Type (Sub_Type : Iir) return Iir is - begin - if Get_Kind (Sub_Type) /= Iir_Kind_Array_Subtype_Definition then - Error_Kind ("get_string_type_bound_type", Sub_Type); - end if; - return Get_First_Element (Get_Index_Subtype_List (Sub_Type)); - end Get_String_Type_Bound_Type; - - procedure Get_Low_High_Limit (Arange : Iir_Range_Expression; - Low, High : out Iir) - is - begin - case Get_Direction (Arange) is - when Iir_To => - Low := Get_Left_Limit (Arange); - High := Get_Right_Limit (Arange); - when Iir_Downto => - High := Get_Left_Limit (Arange); - Low := Get_Right_Limit (Arange); - end case; - end Get_Low_High_Limit; - - function Get_Low_Limit (Arange : Iir_Range_Expression) return Iir is - begin - case Get_Direction (Arange) is - when Iir_To => - return Get_Left_Limit (Arange); - when Iir_Downto => - return Get_Right_Limit (Arange); - end case; - end Get_Low_Limit; - - function Get_High_Limit (Arange : Iir_Range_Expression) return Iir is - begin - case Get_Direction (Arange) is - when Iir_To => - return Get_Right_Limit (Arange); - when Iir_Downto => - return Get_Left_Limit (Arange); - end case; - end Get_High_Limit; - - function Is_One_Dimensional_Array_Type (A_Type : Iir) return Boolean - is - Base_Type : constant Iir := Get_Base_Type (A_Type); - begin - if Get_Kind (Base_Type) = Iir_Kind_Array_Type_Definition - and then Get_Nbr_Elements (Get_Index_Subtype_List (Base_Type)) = 1 - then - return True; - else - return False; - end if; - end Is_One_Dimensional_Array_Type; - - function Is_Range_Attribute_Name (Expr : Iir) return Boolean - is - Attr : Iir; - Id : Name_Id; - begin - if Get_Kind (Expr) = Iir_Kind_Parenthesis_Name then - Attr := Get_Prefix (Expr); - else - Attr := Expr; - end if; - if Get_Kind (Attr) /= Iir_Kind_Attribute_Name then - return False; - end if; - Id := Get_Identifier (Attr); - return Id = Name_Range or Id = Name_Reverse_Range; - end Is_Range_Attribute_Name; - - function Create_Array_Subtype (Arr_Type : Iir; Loc : Location_Type) - return Iir_Array_Subtype_Definition - is - Res : Iir_Array_Subtype_Definition; - Base_Type : Iir; - List : Iir_List; - begin - Res := Create_Iir (Iir_Kind_Array_Subtype_Definition); - Set_Location (Res, Loc); - Base_Type := Get_Base_Type (Arr_Type); - Set_Base_Type (Res, Base_Type); - Set_Element_Subtype (Res, Get_Element_Subtype (Base_Type)); - if Get_Kind (Arr_Type) = Iir_Kind_Array_Subtype_Definition then - Set_Resolution_Indication (Res, Get_Resolution_Indication (Arr_Type)); - end if; - Set_Resolved_Flag (Res, Get_Resolved_Flag (Arr_Type)); - Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Arr_Type)); - Set_Type_Staticness (Res, Get_Type_Staticness (Base_Type)); - List := Create_Iir_List; - Set_Index_Subtype_List (Res, List); - Set_Index_Constraint_List (Res, List); - return Res; - end Create_Array_Subtype; - - function Is_Subprogram_Method (Spec : Iir) return Boolean is - begin - case Get_Kind (Get_Parent (Spec)) is - when Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Protected_Type_Body => - return True; - when others => - return False; - end case; - end Is_Subprogram_Method; - - function Get_Method_Type (Spec : Iir) return Iir - is - Parent : Iir; - begin - Parent := Get_Parent (Spec); - case Get_Kind (Parent) is - when Iir_Kind_Protected_Type_Declaration => - return Parent; - when Iir_Kind_Protected_Type_Body => - return Get_Protected_Type_Declaration (Parent); - when others => - return Null_Iir; - end case; - end Get_Method_Type; - - function Create_Error_Expr (Orig : Iir; Atype : Iir) return Iir - is - Res : Iir; - begin - Res := Create_Iir (Iir_Kind_Error); - Set_Expr_Staticness (Res, None); - Set_Type (Res, Atype); - Set_Error_Origin (Res, Orig); - Location_Copy (Res, Orig); - return Res; - end Create_Error_Expr; - - function Create_Error_Type (Orig : Iir) return Iir - is - Res : Iir; - begin - Res := Create_Iir (Iir_Kind_Error); - --Set_Expr_Staticness (Res, Locally); - Set_Base_Type (Res, Res); - Set_Error_Origin (Res, Orig); - Location_Copy (Res, Orig); - Set_Type_Declarator (Res, Null_Iir); - Set_Resolved_Flag (Res, True); - Set_Signal_Type_Flag (Res, True); - return Res; - end Create_Error_Type; - - -- Extract the entity from ASPECT. - -- Note: if ASPECT is a component declaration, returns ASPECT. - function Get_Entity_From_Entity_Aspect (Aspect : Iir) return Iir - is - Inst : Iir; - begin - case Get_Kind (Aspect) is - when Iir_Kinds_Denoting_Name => - -- A component declaration. - Inst := Get_Named_Entity (Aspect); - pragma Assert (Get_Kind (Inst) = Iir_Kind_Component_Declaration); - return Inst; - when Iir_Kind_Component_Declaration => - return Aspect; - when Iir_Kind_Entity_Aspect_Entity => - return Get_Entity (Aspect); - when Iir_Kind_Entity_Aspect_Configuration => - Inst := Get_Configuration (Aspect); - return Get_Entity (Inst); - when Iir_Kind_Entity_Aspect_Open => - return Null_Iir; - when others => - Error_Kind ("get_entity_from_entity_aspect", Aspect); - end case; - end Get_Entity_From_Entity_Aspect; - - function Is_Signal_Object (Name : Iir) return Boolean - is - Adecl: Iir; - begin - Adecl := Get_Object_Prefix (Name, True); - case Get_Kind (Adecl) is - when Iir_Kind_Signal_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kinds_Signal_Attribute => - return True; - when Iir_Kind_Object_Alias_Declaration => - raise Internal_Error; - when others => - return False; - end case; - end Is_Signal_Object; - - -- LRM08 4.7 Package declarations - -- If the package header is empty, the package declared by a package - -- declaration is called a simple package. - function Is_Simple_Package (Pkg : Iir) return Boolean is - begin - return Get_Package_Header (Pkg) = Null_Iir; - end Is_Simple_Package; - - -- LRM08 4.7 Package declarations - -- If the package header contains a generic clause and no generic map - -- aspect, the package is called an uninstantiated package. - function Is_Uninstantiated_Package (Pkg : Iir) return Boolean - is - Header : constant Iir := Get_Package_Header (Pkg); - begin - return Header /= Null_Iir - and then Get_Generic_Map_Aspect_Chain (Header) = Null_Iir; - end Is_Uninstantiated_Package; - - -- LRM08 4.7 Package declarations - -- If the package header contains both a generic clause and a generic - -- map aspect, the package is declared a generic-mapped package. - function Is_Generic_Mapped_Package (Pkg : Iir) return Boolean - is - Header : constant Iir := Get_Package_Header (Pkg); - begin - return Header /= Null_Iir - and then Get_Generic_Map_Aspect_Chain (Header) /= Null_Iir; - end Is_Generic_Mapped_Package; - - function Kind_In (N : Iir; K1, K2 : Iir_Kind) return Boolean - is - K : constant Iir_Kind := Get_Kind (N); - begin - return K = K1 or K = K2; - end Kind_In; - - function Get_HDL_Node (N : PSL_Node) return Iir is - begin - return Iir (PSL.Nodes.Get_HDL_Node (N)); - end Get_HDL_Node; - - procedure Set_HDL_Node (N : PSL_Node; Expr : Iir) is - begin - PSL.Nodes.Set_HDL_Node (N, PSL.Nodes.HDL_Node (Expr)); - end Set_HDL_Node; -end Iirs_Utils; diff --git a/iirs_utils.ads b/iirs_utils.ads deleted file mode 100644 index a588ab870..000000000 --- a/iirs_utils.ads +++ /dev/null @@ -1,250 +0,0 @@ --- Common operations on nodes. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Types; use Types; -with Iirs; use Iirs; - -package Iirs_Utils is - -- Transform the current token into an iir literal. - -- The current token must be either a character, a string or an identifier. - function Current_Text return Iir; - - -- Get identifier of NODE as a string. - function Image_Identifier (Node : Iir) return String; - function Image_String_Lit (Str : Iir) return String; - - -- Easier function for string literals. - function Get_String_Fat_Acc (Str : Iir) return String_Fat_Acc; - pragma Inline (Get_String_Fat_Acc); - - -- Return True iff N is an error node. - function Is_Error (N : Iir) return Boolean; - pragma Inline (Is_Error); - - -- Find LIT in the list of identifiers or characters LIST. - -- Return the literal (whose name is LIT) or null_iir if not found. - function Find_Name_In_Chain (Chain: Iir; Lit: Name_Id) return Iir; - function Find_Name_In_List (List : Iir_List; Lit: Name_Id) return Iir; - - -- Return TRUE if EL in an element of chain CHAIN. - function Is_In_Chain (Chain : Iir; El : Iir) return Boolean; - - -- Convert an operator node to a name. - function Get_Operator_Name (Op : Iir) return Name_Id; - - -- Get the longuest static prefix of EXPR. - -- See LRM §8.1 - function Get_Longuest_Static_Prefix (Expr: Iir) return Iir; - - -- Get the prefix of NAME, ie the declaration at the base of NAME. - -- Return NAME itself if NAME is not an object or a subelement of - -- an object. If WITH_ALIAS is true, continue with the alias name when an - -- alias is found, else return the alias. - -- FIXME: clarify when NAME is returned. - function Get_Object_Prefix (Name: Iir; With_Alias : Boolean := True) - return Iir; - - - -- Get the interface associated by the association ASSOC. This is always - -- an interface, even if the formal is a name. - function Get_Association_Interface (Assoc : Iir) return Iir; - - -- Duplicate enumeration literal LIT. - function Copy_Enumeration_Literal (Lit : Iir) return Iir; - - -- Make TARGETS depends on UNIT. - -- UNIT must be either a design unit or a entity_aspect_entity. - procedure Add_Dependence (Target: Iir_Design_Unit; Unit: Iir); - - -- Clear configuration field of all component instantiation of - -- the concurrent statements of PARENT. - procedure Clear_Instantiation_Configuration (Parent : Iir; Full : Boolean); - - -- Free Node and its prefixes, if any. - procedure Free_Name (Node : Iir); - - -- Free NODE and its sub-nodes. - procedure Free_Recursive (Node : Iir; Free_List : Boolean := False); - - -- Name of FUNC. - function Get_Predefined_Function_Name (Func : Iir_Predefined_Functions) - return String; - - -- Mark SUBPRG as used. If SUBPRG is an instance, its generic is also - -- marked. - procedure Mark_Subprogram_Used (Subprg : Iir); - - -- Create the range_constraint node for an enumeration type. - procedure Create_Range_Constraint_For_Enumeration_Type - (Def : Iir_Enumeration_Type_Definition); - - -- Return the node containing the Callees_List (ie the subprogram body if - -- SUBPRG is a subprogram spec, SUBPRG if SUBPRG is a process). - function Get_Callees_List_Holder (Subprg : Iir) return Iir; - - -- Clear flag of TOP and all of its callees. - procedure Clear_Seen_Flag (Top : Iir); - - -- Return TRUE iff DEF is an anonymous type (or subtype) definition. - -- Note: DEF is required to be a type (or subtype) definition. - -- Note: type (and not subtype) are never anonymous. - function Is_Anonymous_Type_Definition (Def : Iir) return Boolean; - pragma Inline (Is_Anonymous_Type_Definition); - - -- Return TRUE iff DEF is a fully constrained type (or subtype) definition. - function Is_Fully_Constrained_Type (Def : Iir) return Boolean; - - -- Return the type definition/subtype indication of NAME if NAME denotes - -- a type or subtype name. Otherwise, return Null_Iir; - function Is_Type_Name (Name : Iir) return Iir; - - -- Return TRUE iff SPEC is the subprogram specification of a subprogram - -- body which was previously declared. In that case, the only use of SPEC - -- is to match the body with its declaration. - function Is_Second_Subprogram_Specification (Spec : Iir) return Boolean; - - -- If NAME is a simple or an expanded name, return the denoted declaration. - -- Otherwise, return NAME. - function Strip_Denoting_Name (Name : Iir) return Iir; - - -- Build a simple name node whose named entity is REF and location LOC. - function Build_Simple_Name (Ref : Iir; Loc : Location_Type) return Iir; - function Build_Simple_Name (Ref : Iir; Loc : Iir) return Iir; - - -- If SUBTYP has a resolution indication that is a function name, returns - -- the function declaration (not the name). - function Has_Resolution_Function (Subtyp : Iir) return Iir; - - -- Return a simple name for the primary unit of physical type PHYSICAL_DEF. - -- This is the artificial unit name for the value of the primary unit, thus - -- its location is the location of the primary unit. Used mainly to build - -- evaluated literals. - function Get_Primary_Unit_Name (Physical_Def : Iir) return Iir; - - -- Get the type of any node representing a subtype indication. This simply - -- skip over denoting names. - function Get_Type_Of_Subtype_Indication (Ind : Iir) return Iir; - - -- Get the type of an index_subtype_definition or of a discrete_range from - -- an index_constraint. - function Get_Index_Type (Index_Type : Iir) return Iir - renames Get_Type_Of_Subtype_Indication; - - -- Return the IDX-th index type for index subtype definition list or - -- index_constraint INDEXES. Return Null_Iir if IDX is out of dimension - -- bounds, so that this function can be used to iterator over indexes of - -- a type (or subtype). Note that IDX starts at 0. - function Get_Index_Type (Indexes : Iir_List; Idx : Natural) return Iir; - - -- Likewise but for array type or subtype ARRAY_TYPE. - function Get_Index_Type (Array_Type : Iir; Idx : Natural) return Iir; - - -- Return the type or subtype definition of the SUBTYP type mark. - function Get_Denoted_Type_Mark (Subtyp : Iir) return Iir; - - -- Return true iff L and R have the same profile. - -- L and R must be subprograms specification (or spec_body). - function Is_Same_Profile (L, R: Iir) return Boolean; - - -- From a block_specification, returns the block. - -- Roughly speaking, this get prefix of indexed and sliced name. - function Get_Block_From_Block_Specification (Block_Spec : Iir) - return Iir; - - -- Wrapper around Get_Entity_Name: return the entity declaration of the - -- entity name of DECL. - function Get_Entity (Decl : Iir) return Iir; - - -- Wrapper around get_Configuration_Name: return the configuration - -- declaration of ASPECT. - function Get_Configuration (Aspect : Iir) return Iir; - - -- Return the identifier of the entity for architecture ARCH. - function Get_Entity_Identifier_Of_Architecture (Arch : Iir) return Name_Id; - - -- Return True is component instantiation statement INST instantiate a - -- component. - function Is_Component_Instantiation - (Inst : Iir_Component_Instantiation_Statement) - return Boolean; - - -- Return True is component instantiation statement INST instantiate a - -- design entity. - function Is_Entity_Instantiation - (Inst : Iir_Component_Instantiation_Statement) - return Boolean; - - -- Return the bound type of a string type, ie the type of the (first) - -- dimension of a one-dimensional array type. - function Get_String_Type_Bound_Type (Sub_Type : Iir) return Iir; - - -- Return left or right limit according to the direction. - procedure Get_Low_High_Limit (Arange : Iir_Range_Expression; - Low, High : out Iir); - function Get_Low_Limit (Arange : Iir_Range_Expression) return Iir; - function Get_High_Limit (Arange : Iir_Range_Expression) return Iir; - - -- Return TRUE iff type/subtype definition A_TYPE is an undim array. - function Is_One_Dimensional_Array_Type (A_Type : Iir) return Boolean; - - -- Return TRUE iff unsemantized EXPR is a range attribute. - function Is_Range_Attribute_Name (Expr : Iir) return Boolean; - - -- Create an array subtype from array_type or array_subtype ARR_TYPE. - -- All fields of the returned node are filled, except the index_list. - -- The type_staticness is set with the type staticness of the element - -- subtype and therefore must be updated. - -- The type_declarator field is set to null_iir. - function Create_Array_Subtype (Arr_Type : Iir; Loc : Location_Type) - return Iir_Array_Subtype_Definition; - - -- Return TRUE iff SPEC is declared inside a protected type or a protected - -- body. - function Is_Subprogram_Method (Spec : Iir) return Boolean; - - -- Return the protected type for method SPEC. - function Get_Method_Type (Spec : Iir) return Iir; - - -- Create an error node for node ORIG, and set its type to ATYPE. - -- Set its staticness to locally. - function Create_Error_Expr (Orig : Iir; Atype : Iir) return Iir; - - -- Create an error node for node ORIG, which is supposed to be a type. - function Create_Error_Type (Orig : Iir) return Iir; - - -- Extract the entity from ASPECT. - -- Note: if ASPECT is a component declaration, returns ASPECT. - -- if ASPECT is open, return Null_Iir; - function Get_Entity_From_Entity_Aspect (Aspect : Iir) return Iir; - - -- Definitions from LRM08 4.7 Package declarations. - -- PKG must denote a package declaration. - function Is_Simple_Package (Pkg : Iir) return Boolean; - function Is_Uninstantiated_Package (Pkg : Iir) return Boolean; - function Is_Generic_Mapped_Package (Pkg : Iir) return Boolean; - - -- Return TRUE if the base name of NAME is a signal object. - function Is_Signal_Object (Name: Iir) return Boolean; - - -- Return True IFF kind of N is K1 or K2. - function Kind_In (N : Iir; K1, K2 : Iir_Kind) return Boolean; - pragma Inline (Kind_In); - - -- IIR wrapper around Get_HDL_Node/Set_HDL_Node. - function Get_HDL_Node (N : PSL_Node) return Iir; - procedure Set_HDL_Node (N : PSL_Node; Expr : Iir); -end Iirs_Utils; diff --git a/iirs_walk.adb b/iirs_walk.adb deleted file mode 100644 index 399832907..000000000 --- a/iirs_walk.adb +++ /dev/null @@ -1,115 +0,0 @@ --- Walk in iirs nodes. --- Copyright (C) 2009 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GCC; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -package body Iirs_Walk is - function Walk_Chain (Chain : Iir; Cb : Walk_Cb) return Walk_Status - is - El : Iir; - Status : Walk_Status := Walk_Continue; - begin - El := Chain; - while El /= Null_Iir loop - Status := Cb.all (El); - exit when Status /= Walk_Continue; - El := Get_Chain (El); - end loop; - return Status; - end Walk_Chain; - - function Walk_Sequential_Stmt (Stmt : Iir; Cb : Walk_Cb) return Walk_Status; - - - function Walk_Sequential_Stmt_Chain (Chain : Iir; Cb : Walk_Cb) - return Walk_Status - is - El : Iir; - Status : Walk_Status := Walk_Continue; - begin - El := Chain; - while El /= Null_Iir loop - Status := Cb.all (El); - exit when Status /= Walk_Continue; - Status := Walk_Sequential_Stmt (El, Cb); - exit when Status /= Walk_Continue; - El := Get_Chain (El); - end loop; - return Status; - end Walk_Sequential_Stmt_Chain; - - function Walk_Sequential_Stmt (Stmt : Iir; Cb : Walk_Cb) return Walk_Status - is - Status : Walk_Status := Walk_Continue; - Chain : Iir; - begin - case Iir_Kinds_Sequential_Statement (Get_Kind (Stmt)) is - when Iir_Kind_Signal_Assignment_Statement - | Iir_Kind_Null_Statement - | Iir_Kind_Assertion_Statement - | Iir_Kind_Report_Statement - | Iir_Kind_Wait_Statement - | Iir_Kind_Return_Statement - | Iir_Kind_Procedure_Call_Statement - | Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement - | Iir_Kind_Variable_Assignment_Statement => - null; - when Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement => - Status := Walk_Sequential_Stmt_Chain - (Get_Sequential_Statement_Chain (Stmt), Cb); - when Iir_Kind_Case_Statement => - Chain := Get_Case_Statement_Alternative_Chain (Stmt); - while Chain /= Null_Iir loop - Status := Walk_Sequential_Stmt_Chain - (Get_Associated_Chain (Chain), Cb); - exit when Status /= Walk_Continue; - Chain := Get_Chain (Chain); - end loop; - when Iir_Kind_If_Statement => - Chain := Stmt; - while Chain /= Null_Iir loop - Status := Walk_Sequential_Stmt_Chain - (Get_Sequential_Statement_Chain (Chain), Cb); - exit when Status /= Walk_Continue; - Chain := Get_Else_Clause (Chain); - end loop; - end case; - return Status; - end Walk_Sequential_Stmt; - - function Walk_Assignment_Target (Target : Iir; Cb : Walk_Cb) - return Walk_Status - is - Chain : Iir; - Status : Walk_Status := Walk_Continue; - begin - case Get_Kind (Target) is - when Iir_Kind_Aggregate => - Chain := Get_Association_Choices_Chain (Target); - while Chain /= Null_Iir loop - Status := - Walk_Assignment_Target (Get_Associated_Expr (Chain), Cb); - exit when Status /= Walk_Continue; - Chain := Get_Chain (Chain); - end loop; - when others => - Status := Cb.all (Target); - end case; - return Status; - end Walk_Assignment_Target; -end Iirs_Walk; diff --git a/iirs_walk.ads b/iirs_walk.ads deleted file mode 100644 index 4c098f7d5..000000000 --- a/iirs_walk.ads +++ /dev/null @@ -1,45 +0,0 @@ --- Walk in iirs nodes. --- Copyright (C) 2009 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GCC; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Iirs; use Iirs; - -package Iirs_Walk is - type Walk_Status is - ( - -- Continue to walk. - Walk_Continue, - - -- Stop walking in the subtree, continue in the parent tree. - Walk_Up, - - -- Abort the walk. - Walk_Abort); - - type Walk_Cb is access function (El : Iir) return Walk_Status; - - -- Walk on all elements of CHAIN. - function Walk_Chain (Chain : Iir; Cb : Walk_Cb) return Walk_Status; - - - function Walk_Assignment_Target (Target : Iir; Cb : Walk_Cb) - return Walk_Status; - - -- Walk on all stmts and sub-stmts of CHAIN. - function Walk_Sequential_Stmt_Chain (Chain : Iir; Cb : Walk_Cb) - return Walk_Status; -end Iirs_Walk; diff --git a/libraries.adb b/libraries.adb deleted file mode 100644 index 7fd2b69ef..000000000 --- a/libraries.adb +++ /dev/null @@ -1,1714 +0,0 @@ --- VHDL libraries handling. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Ada.Text_IO; use Ada.Text_IO; -with GNAT.Table; -with GNAT.OS_Lib; -with Interfaces.C_Streams; -with System; -with Errorout; use Errorout; -with Scanner; -with Iirs_Utils; use Iirs_Utils; -with Parse; -with Back_End; -with Name_Table; use Name_Table; -with Str_Table; -with Sem_Scopes; -with Tokens; -with Files_Map; -with Flags; -with Std_Package; - -package body Libraries is - -- Chain of known libraries. This is also the top node of all iir node. - Libraries_Chain : Iir_Library_Declaration := Null_Iir; - Libraries_Chain_Last : Iir_Library_Declaration := Null_Iir; - - -- A location for any implicit declarations (such as library WORK). - Implicit_Location: Location_Type; - - -- Table of library pathes. - package Pathes is new GNAT.Table - (Table_Index_Type => Integer, - Table_Component_Type => Name_Id, - Table_Low_Bound => 1, - Table_Initial => 4, - Table_Increment => 100); - - -- Initialize pathes table. - -- Set the local path. - procedure Init_Pathes - is - begin - Name_Nil := Get_Identifier (""); - Pathes.Append (Name_Nil); - Local_Directory := Name_Nil; - Work_Directory := Name_Nil; - end Init_Pathes; - - function Path_To_Id (Path : String) return Name_Id is - begin - if Path (Path'Last) /= GNAT.OS_Lib.Directory_Separator then - return Get_Identifier (Path & GNAT.OS_Lib.Directory_Separator); - else - return Get_Identifier (Path); - end if; - end Path_To_Id; - - procedure Add_Library_Path (Path : String) - is - begin - if Path'Length = 0 then - return; - end if; - -- Nice message instead of constraint_error. - if Path'Length + 2 >= Name_Buffer'Length then - Error_Msg ("argument of -P is too long"); - return; - end if; - Pathes.Append (Path_To_Id (Path)); - end Add_Library_Path; - - function Get_Nbr_Pathes return Natural is - begin - return Pathes.Last; - end Get_Nbr_Pathes; - - function Get_Path (N : Natural) return Name_Id is - begin - if N > Pathes.Last or N < Pathes.First then - raise Constraint_Error; - end if; - return Pathes.Table (N); - end Get_Path; - - -- Set PATH as the path of the work library. - procedure Set_Work_Library_Path (Path : String) is - begin - Work_Directory := Path_To_Id (Path); - if not GNAT.OS_Lib.Is_Directory (Get_Address (Work_Directory)) then - -- This is a warning, since 'clean' action should not fail in - -- this cases. - Warning_Msg - ("directory '" & Path & "' set by --workdir= does not exist"); - -- raise Option_Error; - end if; - end Set_Work_Library_Path; - - -- Open LIBRARY map file, return TRUE if successful. - function Set_Library_File_Name (Dir : Name_Id; - Library: Iir_Library_Declaration) - return Boolean - is - File_Name : constant String := Back_End.Library_To_File_Name (Library); - Fe : Source_File_Entry; - begin - Fe := Files_Map.Load_Source_File (Dir, Get_Identifier (File_Name)); - if Fe = No_Source_File_Entry then - return False; - end if; - Scanner.Set_File (Fe); - return True; - end Set_Library_File_Name; - - -- Every design unit is put in this hash table to be quickly found by - -- its (primary) identifier. - Unit_Hash_Length : constant Name_Id := 127; - subtype Hash_Id is Name_Id range 0 .. Unit_Hash_Length - 1; - Unit_Hash_Table : array (Hash_Id) of Iir := (others => Null_Iir); - - -- Get the hash value for DESIGN_UNIT. - -- Architectures use the entity name. - function Get_Hash_Id_For_Unit (Design_Unit : Iir_Design_Unit) - return Hash_Id - is - Lib_Unit : Iir; - Id : Name_Id; - begin - Lib_Unit := Get_Library_Unit (Design_Unit); - case Get_Kind (Lib_Unit) is - when Iir_Kind_Entity_Declaration - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Package_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Package_Instantiation_Declaration => - Id := Get_Identifier (Lib_Unit); - when Iir_Kind_Architecture_Body => - -- Architectures are put with the entity identifier. - Id := Get_Entity_Identifier_Of_Architecture (Lib_Unit); - when others => - Error_Kind ("get_Hash_Id_For_Unit", Lib_Unit); - end case; - return Id mod Unit_Hash_Length; - end Get_Hash_Id_For_Unit; - - -- Put DESIGN_UNIT into the unit hash table. - procedure Add_Unit_Hash (Design_Unit : Iir) - is - Id : Hash_Id; - begin - Id := Get_Hash_Id_For_Unit (Design_Unit); - Set_Hash_Chain (Design_Unit, Unit_Hash_Table (Id)); - Unit_Hash_Table (Id) := Design_Unit; - end Add_Unit_Hash; - - -- Remove DESIGN_UNIT from the unit hash table. - procedure Remove_Unit_Hash (Design_Unit : Iir) - is - Id : Hash_Id; - Unit, Prev, Next : Iir_Design_Unit; - begin - Id := Get_Hash_Id_For_Unit (Design_Unit); - Unit := Unit_Hash_Table (Id); - Prev := Null_Iir; - while Unit /= Null_Iir loop - Next := Get_Hash_Chain (Unit); - if Unit = Design_Unit then - if Prev = Null_Iir then - Unit_Hash_Table (Id) := Next; - else - Set_Hash_Chain (Prev, Next); - end if; - return; - end if; - Prev := Unit; - Unit := Next; - end loop; - -- Not found. - raise Internal_Error; - end Remove_Unit_Hash; - - procedure Purge_Design_File (Design_File : Iir_Design_File) - is - Prev, File, Next : Iir_Design_File; - Unit : Iir_Design_Unit; - - File_Name : Name_Id; - Dir_Name : Name_Id; - begin - File_Name := Get_Design_File_Filename (Design_File); - Dir_Name := Get_Design_File_Directory (Design_File); - - File := Get_Design_File_Chain (Work_Library); - Prev := Null_Iir; - while File /= Null_Iir loop - Next := Get_Chain (File); - if Get_Design_File_Filename (File) = File_Name - and then Get_Design_File_Directory (File) = Dir_Name - then - -- Remove from library. - if Prev = Null_Iir then - Set_Design_File_Chain (Work_Library, Next); - else - Set_Chain (Prev, Next); - end if; - - -- Remove all units from unit hash table. - Unit := Get_First_Design_Unit (File); - while Unit /= Null_Iir loop - Remove_Unit_Hash (Unit); - Unit := Get_Chain (Unit); - end loop; - - return; - end if; - Prev := File; - File := Next; - end loop; - end Purge_Design_File; - - -- Load the contents of a library from a map file. - -- The format of this file, used by save_library and load_library is - -- as follow: - -- - -- file_format ::= header { design_file_format } - -- header ::= v 3 - -- design_file_format ::= - -- filename_format { design_unit_format } - -- filename_format ::= - -- FILE directory "FILENAME" file_time_stamp analyze_time_stamp: - -- design_unit_format ::= entity_format - -- | architecture_format - -- | package_format - -- | package_body_format - -- | configuration_format - -- position_format ::= LINE(POS) + OFF on DATE - -- entity_format ::= - -- ENTITY identifier AT position_format ; - -- architecture_format ::= - -- ARCHITECTURE identifier of name AT position_format ; - -- package_format ::= - -- PACKAGE identifier AT position_format [BODY] ; - -- package_body_format ::= - -- PACKAGE BODY identifier AT position_format ; - -- configuration_format ::= - -- CONFIGURATION identifier AT position_format ; - -- - -- The position_format meaning is: - -- LINE is the line number (first line is number 1), - -- POS is the offset of this line number, as a source_ptr value, - -- OFF is the offset in the line, starting with 0. - -- DATE is the symbolic date of analysis (order). - -- - -- Return TRUE if the library was found. - function Load_Library (Library: Iir_Library_Declaration) - return Boolean - is - use Scanner; - use Tokens; - - File : Source_File_Entry; - - procedure Bad_Library_Format is - begin - Error_Msg (Image (Files_Map.Get_File_Name (File)) & - ": bad library format"); - end Bad_Library_Format; - - procedure Scan_Expect (Tok: Token_Type) is - begin - Scan; - if Current_Token /= Tok then - Bad_Library_Format; - raise Compilation_Error; - end if; - end Scan_Expect; - - function Current_Time_Stamp return Time_Stamp_Id is - begin - if Current_String_Length /= Time_Stamp_String'Length then - Bad_Library_Format; - raise Compilation_Error; - end if; - return Time_Stamp_Id (Current_String_Id); - end Current_Time_Stamp; - - function String_To_Name_Id return Name_Id - is - Len : Int32; - Ptr : String_Fat_Acc; - begin - Len := Current_String_Length; - Ptr := Str_Table.Get_String_Fat_Acc (Current_String_Id); - for I in 1 .. Len loop - Name_Table.Name_Buffer (Natural (I)) := Ptr (I); - end loop; - Name_Table.Name_Length := Natural (Len); - -- FIXME: should remove last string. - return Get_Identifier; - end String_To_Name_Id; - - Design_Unit, Last_Design_Unit : Iir_Design_Unit; - Lib_Ident : Name_Id; - - function Scan_Unit_List return Iir_List is - begin - if Current_Token = Tok_Left_Paren then - Scan_Expect (Tok_Identifier); - loop - Scan_Expect (Tok_Dot); - Scan_Expect (Tok_Identifier); - Scan; - if Current_Token = Tok_Left_Paren then - -- This is an architecture. - Scan_Expect (Tok_Identifier); - Scan_Expect (Tok_Right_Paren); - Scan; - end if; - exit when Current_Token /= Tok_Comma; - Scan; - end loop; - Scan; - end if; - return Null_Iir_List; - end Scan_Unit_List; - - Design_File: Iir_Design_File; - Library_Unit: Iir; - Line, Col: Int32; - File_Dir : Name_Id; - Pos: Source_Ptr; - Date: Date_Type; - Max_Date: Date_Type := Date_Valid'First; - Dir : Name_Id; - begin - Lib_Ident := Get_Identifier (Library); - - if False then - Ada.Text_IO.Put_Line ("Load library " & Image (Lib_Ident)); - end if; - - -- Check the library was not already loaded. - if Get_Design_File_Chain (Library) /= Null_Iir then - raise Internal_Error; - end if; - - -- Try to open the library file map. - Dir := Get_Library_Directory (Library); - if Dir = Null_Identifier then - -- Search in the library path. - declare - File_Name : constant String := - Back_End.Library_To_File_Name (Library); - L : Natural; - begin - for I in Pathes.First .. Pathes.Last loop - Image (Pathes.Table (I)); - L := Name_Length + File_Name'Length; - Name_Buffer (Name_Length + 1 .. L) := File_Name; - Name_Buffer (L + 1) := Character'Val (0); - if GNAT.OS_Lib.Is_Regular_File (Name_Buffer'Address) then - Dir := Pathes.Table (I); - Set_Library_Directory (Library, Dir); - exit; - end if; - end loop; - end; - end if; - if Dir = Null_Identifier - or else not Set_Library_File_Name (Dir, Library) - then - -- Not found. - Set_Date (Library, Date_Valid'First); - return False; - end if; - File := Get_Current_Source_File; - - -- Parse header. - Scan; - if Current_Token /= Tok_Identifier - or else Name_Length /= 1 or else Name_Buffer (1) /= 'v' - then - Bad_Library_Format; - raise Compilation_Error; - end if; - Scan_Expect (Tok_Integer); - if Current_Iir_Int64 not in 1 .. 3 then - Bad_Library_Format; - raise Compilation_Error; - end if; - Scan; - - Last_Design_Unit := Null_Iir; - while Current_Token /= Tok_Eof loop - if Current_Token = Tok_File then - -- This is a new design file. - Design_File := Create_Iir (Iir_Kind_Design_File); - - Scan; - if Current_Token = Tok_Dot then - -- The filename is local, use the directory of the library. - if Dir = Name_Nil then - File_Dir := Files_Map.Get_Home_Directory; - else - File_Dir := Dir; - end if; - elsif Current_Token = Tok_Slash then - -- The filename is an absolute file. - File_Dir := Null_Identifier; - elsif Current_Token = Tok_String then - -- Be compatible with version 1: an empty directory for - -- an absolute filename. - if Current_String_Length = 0 then - File_Dir := Null_Identifier; - else - File_Dir := String_To_Name_Id; - end if; - else - Bad_Library_Format; - raise Compilation_Error; - end if; - - Set_Design_File_Directory (Design_File, File_Dir); - - Scan_Expect (Tok_String); - Set_Design_File_Filename (Design_File, String_To_Name_Id); - - -- FIXME: check the file name is uniq. - - Set_Parent (Design_File, Library); - - -- Prepend. - Set_Chain (Design_File, Get_Design_File_Chain (Library)); - Set_Design_File_Chain (Library, Design_File); - - Scan_Expect (Tok_String); - Set_File_Time_Stamp (Design_File, Current_Time_Stamp); - - Scan_Expect (Tok_String); - Set_Analysis_Time_Stamp (Design_File, Current_Time_Stamp); - - Scan_Expect (Tok_Colon); - Scan; - Last_Design_Unit := Null_Iir; - else - -- This is a new design unit. - Design_Unit := Create_Iir (Iir_Kind_Design_Unit); - Set_Design_File (Design_Unit, Design_File); - case Current_Token is - when Tok_Entity => - Library_Unit := Create_Iir (Iir_Kind_Entity_Declaration); - Scan; - when Tok_Architecture => - Library_Unit := Create_Iir (Iir_Kind_Architecture_Body); - Scan; - when Tok_Configuration => - Library_Unit := - Create_Iir (Iir_Kind_Configuration_Declaration); - Scan; - when Tok_Package => - Scan; - if Current_Token = Tok_Body then - Library_Unit := Create_Iir (Iir_Kind_Package_Body); - Scan; - else - Library_Unit := Create_Iir (Iir_Kind_Package_Declaration); - end if; - when Tok_With => - if Library_Unit = Null_Iir - or else - Get_Kind (Library_Unit) /= Iir_Kind_Architecture_Body - then - Put_Line ("load_library: invalid use of 'with'"); - raise Internal_Error; - end if; - Scan_Expect (Tok_Configuration); - Scan_Expect (Tok_Colon); - Scan; - Set_Dependence_List (Design_Unit, Scan_Unit_List); - goto Next_Line; - when others => - Put_Line - ("load_library: line must start with " & - "'architecture', 'entity', 'package' or 'configuration'"); - raise Internal_Error; - end case; - - if Current_Token /= Tok_Identifier then - raise Internal_Error; - end if; - Set_Identifier (Library_Unit, Current_Identifier); - Set_Identifier (Design_Unit, Current_Identifier); - - if Get_Kind (Library_Unit) = Iir_Kind_Architecture_Body then - Scan_Expect (Tok_Of); - Scan_Expect (Tok_Identifier); - Set_Entity_Name (Library_Unit, Current_Text); - end if; - - -- Scan position. - Scan_Expect (Tok_Identifier); -- at - Scan_Expect (Tok_Integer); - Line := Int32 (Current_Iir_Int64); - Scan_Expect (Tok_Left_Paren); - Scan_Expect (Tok_Integer); - Pos := Source_Ptr (Current_Iir_Int64); - Scan_Expect (Tok_Right_Paren); - Scan_Expect (Tok_Plus); - Scan_Expect (Tok_Integer); - Col := Int32 (Current_Iir_Int64); - Scan_Expect (Tok_On); - Scan_Expect (Tok_Integer); - Date := Date_Type (Current_Iir_Int64); - - Scan; - if Get_Kind (Library_Unit) = Iir_Kind_Package_Declaration - and then Current_Token = Tok_Body - then - Set_Need_Body (Library_Unit, True); - Scan; - end if; - if Current_Token /= Tok_Semi_Colon then - raise Internal_Error; - end if; - Scan; - - if False then - Put_Line ("line:" & Int32'Image (Line) - & ", pos:" & Source_Ptr'Image (Pos)); - end if; - - -- Scan dependence list. - Set_Dependence_List (Design_Unit, Scan_Unit_List); - - -- Keep the position of the design unit. - --Set_Location (Design_Unit, Location_Type (File)); - --Set_Location (Library_Unit, Location_Type (File)); - Set_Design_Unit_Source_Pos (Design_Unit, Pos); - Set_Design_Unit_Source_Line (Design_Unit, Line); - Set_Design_Unit_Source_Col (Design_Unit, Col); - Set_Date (Design_Unit, Date); - if Date > Max_Date then - Max_Date := Date; - end if; - Set_Date_State (Design_Unit, Date_Disk); - Set_Library_Unit (Design_Unit, Library_Unit); - Set_Design_Unit (Library_Unit, Design_Unit); - - -- Add in the unit hash table. - Add_Unit_Hash (Design_Unit); - - if Last_Design_Unit = Null_Iir then - Set_First_Design_Unit (Design_File, Design_Unit); - else - Set_Chain (Last_Design_Unit, Design_Unit); - end if; - Last_Design_Unit := Design_Unit; - Set_Last_Design_Unit (Design_File, Design_Unit); - end if; - << Next_Line >> null; - end loop; - Set_Date (Library, Max_Date); - Close_File; - return True; - end Load_Library; - - procedure Create_Virtual_Locations - is - use Files_Map; - Implicit_Source_File : Source_File_Entry; - Command_Source_File : Source_File_Entry; - begin - Implicit_Source_File := Create_Virtual_Source_File - (Get_Identifier ("*implicit*")); - Command_Source_File := Create_Virtual_Source_File - (Get_Identifier ("*command line*")); - Command_Line_Location := Source_File_To_Location (Command_Source_File); - Implicit_Location := Source_File_To_Location (Implicit_Source_File); - end Create_Virtual_Locations; - - -- Note: the scanner shouldn't be in use, since this procedure uses it. - procedure Load_Std_Library (Build_Standard : Boolean := True) - is - use Std_Package; - Dir : Name_Id; - begin - if Libraries_Chain /= Null_Iir then - -- This procedure must not be called twice. - raise Internal_Error; - end if; - - Flags.Create_Flag_String; - Create_Virtual_Locations; - - Std_Package.Create_First_Nodes; - - -- Create the library. - Std_Library := Create_Iir (Iir_Kind_Library_Declaration); - Set_Identifier (Std_Library, Std_Names.Name_Std); - Set_Location (Std_Library, Implicit_Location); - Libraries_Chain := Std_Library; - Libraries_Chain_Last := Std_Library; - - if Build_Standard then - Create_Std_Standard_Package (Std_Library); - Add_Unit_Hash (Std_Standard_Unit); - end if; - - if Flags.Bootstrap - and then Work_Library_Name = Std_Names.Name_Std - then - Dir := Work_Directory; - else - Dir := Null_Identifier; - end if; - Set_Library_Directory (Std_Library, Dir); - if Load_Library (Std_Library) = False - and then not Flags.Bootstrap - then - Error_Msg_Option ("cannot find ""std"" library"); - end if; - - if Build_Standard then - -- Add the standard_file into the library. - -- This is done after Load_Library, because it checks there is no - -- previous files in the library. - Set_Parent (Std_Standard_File, Std_Library); - Set_Chain (Std_Standard_File, Get_Design_File_Chain (Std_Library)); - Set_Design_File_Chain (Std_Library, Std_Standard_File); - end if; - - Set_Visible_Flag (Std_Library, True); - end Load_Std_Library; - - procedure Load_Work_Library (Empty : Boolean := False) - is - use Std_Names; - begin - if Work_Library_Name = Name_Std then - if not Flags.Bootstrap then - Error_Msg_Option ("the WORK library cannot be STD"); - return; - end if; - Work_Library := Std_Library; - else - Work_Library := Create_Iir (Iir_Kind_Library_Declaration); - Set_Location (Work_Library, Implicit_Location); - --Set_Visible_Flag (Work_Library, True); - Set_Library_Directory (Work_Library, Work_Directory); - - Set_Identifier (Work_Library, Work_Library_Name); - - if not Empty then - if Load_Library (Work_Library) = False then - null; - end if; - end if; - - -- Add it to the list of libraries. - Set_Chain (Libraries_Chain_Last, Work_Library); - Libraries_Chain_Last := Work_Library; - end if; - Set_Visible_Flag (Work_Library, True); - end Load_Work_Library; - - -- Get or create a library from an identifier. - function Get_Library (Ident: Name_Id; Loc : Location_Type) - return Iir_Library_Declaration - is - Library: Iir_Library_Declaration; - begin - -- library work is a little bit special. - if Ident = Std_Names.Name_Work or else Ident = Work_Library_Name then - if Work_Library = Null_Iir then - -- load_work_library must have been called before. - raise Internal_Error; - end if; - return Work_Library; - end if; - - -- Check if the library has already been loaded. - Library := Iirs_Utils.Find_Name_In_Chain (Libraries_Chain, Ident); - if Library /= Null_Iir then - return Library; - end if; - - -- This is a new library. - if Ident = Std_Names.Name_Std then - -- Load_std_library must have been called before. - raise Internal_Error; - end if; - - Library := Create_Iir (Iir_Kind_Library_Declaration); - Set_Location (Library, Scanner.Get_Token_Location); - Set_Library_Directory (Library, Null_Identifier); - Set_Identifier (Library, Ident); - if Load_Library (Library) = False then - Error_Msg_Sem ("cannot find resource library """ - & Name_Table.Image (Ident) & """", Loc); - end if; - Set_Visible_Flag (Library, True); - - Set_Chain (Libraries_Chain_Last, Library); - Libraries_Chain_Last := Library; - - return Library; - end Get_Library; - - -- Return TRUE if LIBRARY_UNIT and UNIT have identifiers for the same - -- design unit identifier. - -- eg: 'entity A' and 'package A' returns TRUE. - function Is_Same_Library_Unit (Library_Unit, Unit: Iir) return Boolean - is - Entity_Name1, Entity_Name2: Name_Id; - Library_Unit_Kind, Unit_Kind : Iir_Kind; - begin - if Get_Identifier (Unit) /= Get_Identifier (Library_Unit) then - return False; - end if; - - Library_Unit_Kind := Get_Kind (Library_Unit); - Unit_Kind := Get_Kind (Unit); - - -- Package and package body are never the same library unit. - if Library_Unit_Kind = Iir_Kind_Package_Declaration - and then Unit_Kind = Iir_Kind_Package_Body - then - return False; - end if; - if Unit_Kind = Iir_Kind_Package_Declaration - and then Library_Unit_Kind = Iir_Kind_Package_Body - then - return False; - end if; - - -- Two architecture declarations are identical only if they also have - -- the same entity name. - if Unit_Kind = Iir_Kind_Architecture_Body - and then Library_Unit_Kind = Iir_Kind_Architecture_Body - then - Entity_Name1 := Get_Entity_Identifier_Of_Architecture (Unit); - Entity_Name2 := Get_Entity_Identifier_Of_Architecture (Library_Unit); - if Entity_Name1 /= Entity_Name2 then - return False; - end if; - end if; - - -- An architecture declaration never conflits with a library unit that - -- is not an architecture declaration. - if (Unit_Kind = Iir_Kind_Architecture_Body - and then Library_Unit_Kind /= Iir_Kind_Architecture_Body) - or else - (Unit_Kind /= Iir_Kind_Architecture_Body - and then Library_Unit_Kind = Iir_Kind_Architecture_Body) - then - return False; - end if; - - return True; - end Is_Same_Library_Unit; - - procedure Free_Dependence_List (Design : Iir_Design_Unit) - is - List : Iir_List; - El : Iir; - begin - List := Get_Dependence_List (Design); - if List /= Null_Iir_List then - for I in Natural loop - El := Get_Nth_Element (List, I); - exit when El = Null_Iir; - Iirs_Utils.Free_Recursive (El); - end loop; - Destroy_Iir_List (List); - end if; - end Free_Dependence_List; - - -- This procedure is called when the DESIGN_UNIT (either the stub created - -- when a library is read or created from a previous unit in a source - -- file) has been replaced by a new unit. Free everything but DESIGN_UNIT, - -- has it may be referenced in other units (dependence...) - -- FIXME: Isn't the library unit also referenced too ? - procedure Free_Design_Unit (Design_Unit : Iir_Design_Unit) - is - Lib : Iir; - Unit : Iir_Design_Unit; - Dep_List : Iir_List; - begin - -- Free dependence list. - Dep_List := Get_Dependence_List (Design_Unit); - Destroy_Iir_List (Dep_List); - Set_Dependence_List (Design_Unit, Null_Iir_List); - - -- Free default configuration of architecture (if any). - Lib := Get_Library_Unit (Design_Unit); - if Lib /= Null_Iir - and then Get_Kind (Lib) = Iir_Kind_Architecture_Body - then - Free_Iir (Get_Entity_Name (Lib)); - Unit := Get_Default_Configuration_Declaration (Lib); - if Unit /= Null_Iir then - Free_Design_Unit (Unit); - end if; - end if; - - -- Free library unit. - Free_Iir (Lib); - Set_Library_Unit (Design_Unit, Null_Iir); - end Free_Design_Unit; - - procedure Remove_Unit_From_File - (Unit_Ref : Iir_Design_Unit; File : Iir_Design_File) - is - Prev : Iir_Design_Unit; - Unit, Next : Iir_Design_Unit; - begin - Prev := Null_Iir; - Unit := Get_First_Design_Unit (File); - while Unit /= Null_Iir loop - Next := Get_Chain (Unit); - if Unit = Unit_Ref then - if Prev = Null_Iir then - Set_First_Design_Unit (File, Next); - else - Set_Chain (Prev, Next); - end if; - if Next = Null_Iir then - Set_Last_Design_Unit (File, Prev); - end if; - return; - end if; - Prev := Unit; - Unit := Next; - end loop; - -- Not found. - raise Internal_Error; - end Remove_Unit_From_File; - - -- Last design_file used. Kept to speed-up operations. - Last_Design_File : Iir_Design_File := Null_Iir; - - -- Add or replace a design unit in the working library. - procedure Add_Design_Unit_Into_Library - (Unit : in Iir_Design_Unit; Keep_Obsolete : Boolean := False) - is - Design_File: Iir_Design_File; - Design_Unit, Prev_Design_Unit : Iir_Design_Unit; - Last_Unit : Iir_Design_Unit; - Library_Unit: Iir; - New_Library_Unit: Iir; - Unit_Id : Name_Id; - Date: Date_Type; - New_Lib_Time_Stamp : Time_Stamp_Id; - Id : Hash_Id; - - -- File name and dir name of DECL. - File_Name : Name_Id; - Dir_Name : Name_Id; - begin - -- As specified, the Chain must be not set. - pragma Assert (Get_Chain (Unit) = Null_Iir); - - -- The unit must not be in the library. - pragma Assert (Get_Date_State (Unit) = Date_Extern); - - -- Mark this design unit as being loaded. - New_Library_Unit := Get_Library_Unit (Unit); - Unit_Id := Get_Identifier (New_Library_Unit); - - -- Set the date of the design unit as the most recently analyzed - -- design unit. - case Get_Date (Unit) is - when Date_Parsed => - Set_Date_State (Unit, Date_Parse); - when Date_Analyzed => - Date := Get_Date (Work_Library) + 1; - Set_Date (Unit, Date); - Set_Date (Work_Library, Date); - Set_Date_State (Unit, Date_Analyze); - when Date_Valid => - raise Internal_Error; - when others => - raise Internal_Error; - end case; - - -- Set file time stamp. - declare - File : Source_File_Entry; - Pos : Source_Ptr; - begin - Files_Map.Location_To_File_Pos (Get_Location (New_Library_Unit), - File, Pos); - New_Lib_Time_Stamp := Files_Map.Get_File_Time_Stamp (File); - File_Name := Files_Map.Get_File_Name (File); - Image (File_Name); - if GNAT.OS_Lib.Is_Absolute_Path (Name_Buffer (1 .. Name_Length)) then - Dir_Name := Null_Identifier; - else - Dir_Name := Files_Map.Get_Home_Directory; - end if; - end; - - -- Try to find a design unit with the same name in the work library. - Id := Get_Hash_Id_For_Unit (Unit); - Design_Unit := Unit_Hash_Table (Id); - Prev_Design_Unit := Null_Iir; - while Design_Unit /= Null_Iir loop - Design_File := Get_Design_File (Design_Unit); - Library_Unit := Get_Library_Unit (Design_Unit); - if Get_Identifier (Design_Unit) = Unit_Id - and then Get_Library (Design_File) = Work_Library - and then Is_Same_Library_Unit (New_Library_Unit, Library_Unit) - then - -- LIBRARY_UNIT and UNIT designate the same design unit. - -- Remove the old one. - Set_Date (Design_Unit, Date_Obsolete); - declare - Next_Design : Iir; - begin - -- Remove DESIGN_UNIT from the unit_hash. - Next_Design := Get_Hash_Chain (Design_Unit); - if Prev_Design_Unit = Null_Iir then - Unit_Hash_Table (Id) := Next_Design; - else - Set_Hash_Chain (Prev_Design_Unit, Next_Design); - end if; - - -- Remove DESIGN_UNIT from the design_file. - -- If KEEP_OBSOLETE is True, units that are obsoleted by units - -- in the same design file are kept. This allows to process - -- (pretty print, xrefs, ...) all units of a design file. - -- But still remove units that are replaced (if a file was - -- already in the library). - if not Keep_Obsolete - or else Get_Date_State (Design_Unit) = Date_Disk - then - Remove_Unit_From_File (Design_Unit, Design_File); - - Set_Chain (Design_Unit, Obsoleted_Design_Units); - Obsoleted_Design_Units := Design_Unit; - end if; - end; - - -- UNIT *must* replace library_unit if they don't belong - -- to the same file. - if Get_Design_File_Filename (Design_File) = File_Name - and then Get_Design_File_Directory (Design_File) = Dir_Name - then - -- In the same file. - if Get_Date_State (Design_Unit) = Date_Analyze then - -- Warns only if we are not re-analyzing the file. - if Flags.Warn_Library then - Warning_Msg_Sem - ("redefinition of a library unit in " - & "same design file:", Unit); - Warning_Msg_Sem - (Disp_Node (Library_Unit) & " defined at " - & Disp_Location (Library_Unit) & " is now " - & Disp_Node (New_Library_Unit), Unit); - end if; - else - -- Free the stub. - if not Keep_Obsolete then - Free_Design_Unit (Design_Unit); - end if; - end if; - - -- Note: the current design unit should not be freed if - -- in use; unfortunatly, this is not obvious to check. - else - if Flags.Warn_Library then - if Get_Kind (Library_Unit) /= Get_Kind (New_Library_Unit) - then - Warning_Msg ("changing definition of a library unit:"); - Warning_Msg (Disp_Node (Library_Unit) & " is now " - & Disp_Node (New_Library_Unit)); - end if; - Warning_Msg - ("library unit '" - & Iirs_Utils.Image_Identifier (Library_Unit) - & "' was also defined in file '" - & Image (Get_Design_File_Filename (Design_File)) - & '''); - end if; - end if; - exit; - else - Prev_Design_Unit := Design_Unit; - Design_Unit := Get_Hash_Chain (Design_Unit); - end if; - end loop; - - -- Try to find the design file in the library. - -- First try the last one found. - if Last_Design_File /= Null_Iir - and then Get_Library (Last_Design_File) = Work_Library - and then Get_Design_File_Filename (Last_Design_File) = File_Name - and then Get_Design_File_Directory (Last_Design_File) = Dir_Name - then - Design_File := Last_Design_File; - else - -- Search. - Design_File := Get_Design_File_Chain (Work_Library); - while Design_File /= Null_Iir loop - if Get_Design_File_Filename (Design_File) = File_Name - and then Get_Design_File_Directory (Design_File) = Dir_Name - then - exit; - end if; - Design_File := Get_Chain (Design_File); - end loop; - Last_Design_File := Design_File; - end if; - - if Design_File /= Null_Iir - and then not Files_Map.Is_Eq (New_Lib_Time_Stamp, - Get_File_Time_Stamp (Design_File)) - then - -- FIXME: this test is not enough: what about reanalyzing - -- unmodified files (this works only because the order is not - -- changed). - -- Design file is updated. - -- Outdate all other units, overwrite the design_file. - Set_File_Time_Stamp (Design_File, New_Lib_Time_Stamp); - Design_Unit := Get_First_Design_Unit (Design_File); - while Design_Unit /= Null_Iir loop - if Design_Unit /= Unit then - -- Mark other design unit as obsolete. - Set_Date (Design_Unit, Date_Obsolete); - Remove_Unit_Hash (Design_Unit); - else - raise Internal_Error; - end if; - Prev_Design_Unit := Design_Unit; - Design_Unit := Get_Chain (Design_Unit); - - Set_Chain (Prev_Design_Unit, Obsoleted_Design_Units); - Obsoleted_Design_Units := Prev_Design_Unit; - end loop; - Set_First_Design_Unit (Design_File, Null_Iir); - Set_Last_Design_Unit (Design_File, Null_Iir); - end if; - - if Design_File = Null_Iir then - -- This is the first apparition of the design file. - Design_File := Create_Iir (Iir_Kind_Design_File); - Location_Copy (Design_File, Unit); - - Set_Design_File_Filename (Design_File, File_Name); - Set_Design_File_Directory (Design_File, Dir_Name); - - Set_File_Time_Stamp (Design_File, New_Lib_Time_Stamp); - Set_Parent (Design_File, Work_Library); - Set_Chain (Design_File, Get_Design_File_Chain (Work_Library)); - Set_Design_File_Chain (Work_Library, Design_File); - end if; - - -- Add DECL to DESIGN_FILE. - Last_Unit := Get_Last_Design_Unit (Design_File); - if Last_Unit = Null_Iir then - if Get_First_Design_Unit (Design_File) /= Null_Iir then - raise Internal_Error; - end if; - Set_First_Design_Unit (Design_File, Unit); - else - if Get_First_Design_Unit (Design_File) = Null_Iir then - raise Internal_Error; - end if; - Set_Chain (Last_Unit, Unit); - end if; - Set_Last_Design_Unit (Design_File, Unit); - Set_Design_File (Unit, Design_File); - - -- Add DECL in unit hash table. - Set_Hash_Chain (Unit, Unit_Hash_Table (Id)); - Unit_Hash_Table (Id) := Unit; - - -- Update the analyzed time stamp. - Set_Analysis_Time_Stamp (Design_File, Files_Map.Get_Os_Time_Stamp); - end Add_Design_Unit_Into_Library; - - procedure Add_Design_File_Into_Library (File : in out Iir_Design_File) - is - Unit : Iir_Design_Unit; - Next_Unit : Iir_Design_Unit; - First_Unit : Iir_Design_Unit; - begin - Unit := Get_First_Design_Unit (File); - First_Unit := Unit; - Set_First_Design_Unit (File, Null_Iir); - Set_Last_Design_Unit (File, Null_Iir); - while Unit /= Null_Iir loop - Next_Unit := Get_Chain (Unit); - Set_Chain (Unit, Null_Iir); - Libraries.Add_Design_Unit_Into_Library (Unit, True); - Unit := Next_Unit; - end loop; - if First_Unit /= Null_Iir then - File := Get_Design_File (First_Unit); - end if; - end Add_Design_File_Into_Library; - - -- Save the file map of library LIBRARY. - procedure Save_Library (Library: Iir_Library_Declaration) - is - use System; - use Interfaces.C_Streams; - use GNAT.OS_Lib; - Temp_Name: constant String := Image (Work_Directory) - & '_' & Back_End.Library_To_File_Name (Library) & ASCII.NUL; - Mode : constant String := 'w' & ASCII.NUL; - Stream : FILEs; - Success : Boolean; - - -- Write a string to the temporary file. - procedure WR (S : String) - is - Close_Res : int; - pragma Unreferenced (Close_Res); - begin - if Integer (fwrite (S'Address, S'Length, 1, Stream)) /= 1 then - Error_Msg - ("cannot write library file for " & Image_Identifier (Library)); - Close_Res := fclose (Stream); - Delete_File (Temp_Name'Address, Success); - -- Ignore failure to delete the file. - raise Option_Error; - end if; - end WR; - - -- Write a line terminator in the temporary file. - procedure WR_LF is - begin - WR (String'(1 => ASCII.LF)); - end WR_LF; - - Design_File: Iir_Design_File; - Design_Unit: Iir_Design_Unit; - Library_Unit: Iir; - Dir : Name_Id; - - Off, Line: Natural; - Pos: Source_Ptr; - Source_File : Source_File_Entry; - begin - -- Create a temporary file so that the real library is atomically - -- updated, and won't be corrupted in case of Control-C, or concurrent - -- writes. - Stream := fopen (Temp_Name'Address, Mode'Address); - - if Stream = NULL_Stream then - Error_Msg - ("cannot create library file for " & Image_Identifier (Library)); - raise Option_Error; - end if; - - -- Header: version. - WR ("v 3"); - WR_LF; - - Design_File := Get_Design_File_Chain (Library); - while Design_File /= Null_Iir loop - -- Ignore std.standard as there is no corresponding file. - if Design_File = Std_Package.Std_Standard_File then - goto Continue; - end if; - Design_Unit := Get_First_Design_Unit (Design_File); - - if Design_Unit /= Null_Iir then - WR ("file "); - Dir := Get_Design_File_Directory (Design_File); - if Dir = Null_Identifier then - -- Absolute filenames. - WR ("/"); - elsif Work_Directory = Name_Nil - and then Dir = Files_Map.Get_Home_Directory - then - -- If the library is in the current directory, do not write - -- it. This allows to move the library file. - WR ("."); - else - Image (Dir); - WR (""""); - WR (Name_Buffer (1 .. Name_Length)); - WR (""""); - end if; - WR (" """); - Image (Get_Design_File_Filename (Design_File)); - WR (Name_Buffer (1 .. Name_Length)); - WR (""" """); - WR (Files_Map.Get_Time_Stamp_String - (Get_File_Time_Stamp (Design_File))); - WR (""" """); - WR (Files_Map.Get_Time_Stamp_String - (Get_Analysis_Time_Stamp (Design_File))); - WR (""":"); - WR_LF; - end if; - - while Design_Unit /= Null_Iir loop - Library_Unit := Get_Library_Unit (Design_Unit); - - WR (" "); - case Get_Kind (Library_Unit) is - when Iir_Kind_Entity_Declaration => - WR ("entity "); - WR (Image_Identifier (Library_Unit)); - when Iir_Kind_Architecture_Body => - WR ("architecture "); - WR (Image_Identifier (Library_Unit)); - WR (" of "); - WR (Image (Get_Entity_Identifier_Of_Architecture - (Library_Unit))); - when Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration => - WR ("package "); - WR (Image_Identifier (Library_Unit)); - when Iir_Kind_Package_Body => - WR ("package body "); - WR (Image_Identifier (Library_Unit)); - when Iir_Kind_Configuration_Declaration => - WR ("configuration "); - WR (Image_Identifier (Library_Unit)); - when others => - Error_Kind ("save_library", Library_Unit); - end case; - - if Get_Date_State (Design_Unit) = Date_Disk then - Pos := Get_Design_Unit_Source_Pos (Design_Unit); - Line := Natural (Get_Design_Unit_Source_Line (Design_Unit)); - Off := Natural (Get_Design_Unit_Source_Col (Design_Unit)); - else - Files_Map.Location_To_Coord (Get_Location (Design_Unit), - Source_File, Pos, Line, Off); - end if; - - WR (" at"); - WR (Natural'Image (Line)); - WR ("("); - WR (Source_Ptr'Image (Pos)); - WR (") +"); - WR (Natural'Image (Off)); - WR (" on"); - case Get_Date (Design_Unit) is - when Date_Valid - | Date_Analyzed - | Date_Parsed => - WR (Date_Type'Image (Get_Date (Design_Unit))); - when others => - WR (Date_Type'Image (Get_Date (Design_Unit))); - raise Internal_Error; - end case; - if Get_Kind (Library_Unit) = Iir_Kind_Package_Declaration - and then Get_Need_Body (Library_Unit) - then - WR (" body"); - end if; - WR (";"); - WR_LF; - - Design_Unit := Get_Chain (Design_Unit); - end loop; - << Continue >> null; - Design_File := Get_Chain (Design_File); - end loop; - - declare - Fclose_Res : int; - pragma Unreferenced (Fclose_Res); - begin - Fclose_Res := fclose (Stream); - end; - - -- Rename the temporary file to the library file. - -- FIXME: It may fail if they aren't on the same filesystem, but we - -- could assume it doesn't happen (humm...) - declare - use Files_Map; - File_Name: constant String := Image (Work_Directory) - & Back_End.Library_To_File_Name (Library) & ASCII.NUL; - Delete_Success : Boolean; - begin - -- For windows: renames doesn't overwrite destination; so first - -- delete it. This can create races condition on Unix: if the - -- program is killed between delete and rename, the library is lost. - Delete_File (File_Name'Address, Delete_Success); - Rename_File (Temp_Name'Address, File_Name'Address, Success); - if not Success then - -- Renaming may fail if the new filename is in a non-existant - -- directory. - Error_Msg ("cannot update library file """ - & File_Name (File_Name'First .. File_Name'Last - 1) - & """"); - Delete_File (Temp_Name'Address, Success); - raise Option_Error; - end if; - end; - end Save_Library; - - -- Save the map of the work library. - procedure Save_Work_Library is - begin - Save_Library (Work_Library); - end Save_Work_Library; - - -- Return the name of the latest architecture analysed for an entity. - function Get_Latest_Architecture (Entity: Iir_Entity_Declaration) - return Iir_Architecture_Body - is - Entity_Id : Name_Id; - Lib : Iir_Library_Declaration; - Design_File: Iir_Design_File; - Design_Unit: Iir_Design_Unit; - Library_Unit: Iir; - Res: Iir_Design_Unit; - begin - -- FIXME: use hash - Entity_Id := Get_Identifier (Entity); - Lib := Get_Library (Get_Design_File (Get_Design_Unit (Entity))); - Design_File := Get_Design_File_Chain (Lib); - Res := Null_Iir; - while Design_File /= Null_Iir loop - Design_Unit := Get_First_Design_Unit (Design_File); - while Design_Unit /= Null_Iir loop - Library_Unit := Get_Library_Unit (Design_Unit); - - if Get_Kind (Library_Unit) = Iir_Kind_Architecture_Body - and then - Get_Entity_Identifier_Of_Architecture (Library_Unit) = Entity_Id - then - if Res = Null_Iir then - Res := Design_Unit; - elsif Get_Date (Design_Unit) > Get_Date (Res) then - Res := Design_Unit; - end if; - end if; - Design_Unit := Get_Chain (Design_Unit); - end loop; - Design_File := Get_Chain (Design_File); - end loop; - if Res = Null_Iir then - return Null_Iir; - else - return Get_Library_Unit (Res); - end if; - end Get_Latest_Architecture; - - function Load_File (File : Source_File_Entry) return Iir_Design_File - is - Res : Iir_Design_File; - begin - Scanner.Set_File (File); - Res := Parse.Parse_Design_File; - Scanner.Close_File; - if Res /= Null_Iir then - Set_Parent (Res, Work_Library); - Set_Design_File_Filename (Res, Files_Map.Get_File_Name (File)); - end if; - return Res; - end Load_File; - - -- parse a file. - -- Return a design_file without putting it into the library - -- (because it was not semantized). - function Load_File (File_Name: Name_Id) return Iir_Design_File - is - Fe : Source_File_Entry; - begin - Fe := Files_Map.Load_Source_File (Local_Directory, File_Name); - if Fe = No_Source_File_Entry then - Error_Msg_Option ("cannot open " & Image (File_Name)); - return Null_Iir; - end if; - return Load_File (Fe); - end Load_File; - - function Find_Design_Unit (Unit : Iir) return Iir_Design_Unit is - begin - case Get_Kind (Unit) is - when Iir_Kind_Design_Unit => - return Unit; - when Iir_Kind_Selected_Name => - declare - Lib : Iir_Library_Declaration; - begin - Lib := Get_Library (Get_Identifier (Get_Prefix (Unit)), - Get_Location (Unit)); - return Find_Primary_Unit (Lib, Get_Identifier (Unit)); - end; - when Iir_Kind_Entity_Aspect_Entity => - return Find_Secondary_Unit - (Get_Design_Unit (Get_Entity (Unit)), - Get_Identifier (Get_Architecture (Unit))); - when others => - Error_Kind ("find_design_unit", Unit); - end case; - end Find_Design_Unit; - - function Is_Obsolete (Design_Unit : Iir_Design_Unit; Loc : Iir) - return Boolean - is - procedure Error_Obsolete (Msg : String) is - begin - if not Flags.Flag_Elaborate_With_Outdated then - Error_Msg_Sem (Msg, Loc); - end if; - end Error_Obsolete; - - List : Iir_List; - El : Iir; - Unit : Iir_Design_Unit; - U_Ts : Time_Stamp_Id; - Du_Ts : Time_Stamp_Id; - begin - if Get_Date (Design_Unit) = Date_Obsolete then - Error_Obsolete (Disp_Node (Design_Unit) & " is obsolete"); - return True; - end if; - List := Get_Dependence_List (Design_Unit); - if List = Null_Iir_List then - return False; - end if; - Du_Ts := Get_Analysis_Time_Stamp (Get_Design_File (Design_Unit)); - for I in Natural loop - El := Get_Nth_Element (List, I); - exit when El = Null_Iir; - Unit := Find_Design_Unit (El); - if Unit /= Null_Iir then - U_Ts := Get_Analysis_Time_Stamp (Get_Design_File (Unit)); - if Files_Map.Is_Gt (U_Ts, Du_Ts) then - Error_Obsolete - (Disp_Node (Design_Unit) & " is obsoleted by " & - Disp_Node (Unit)); - return True; - elsif Is_Obsolete (Unit, Loc) then - Error_Obsolete - (Disp_Node (Design_Unit) & " depends on obsolete unit"); - return True; - end if; - end if; - end loop; - return False; - end Is_Obsolete; - - procedure Load_Parse_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir) - is - use Scanner; - Line, Off: Natural; - Pos: Source_Ptr; - Res: Iir; - Design_File : Iir_Design_File; - Fe : Source_File_Entry; - begin - -- The unit must not be loaded. - pragma Assert (Get_Date_State (Design_Unit) = Date_Disk); - - -- Load and parse the unit. - Design_File := Get_Design_File (Design_Unit); - Fe := Files_Map.Load_Source_File - (Get_Design_File_Directory (Design_File), - Get_Design_File_Filename (Design_File)); - if Fe = No_Source_File_Entry then - Error_Msg - ("cannot load " & Disp_Node (Get_Library_Unit (Design_Unit))); - raise Compilation_Error; - end if; - Set_File (Fe); - - if not Files_Map.Is_Eq - (Files_Map.Get_File_Time_Stamp (Get_Current_Source_File), - Get_File_Time_Stamp (Design_File)) - then - Error_Msg_Sem - ("file " & Image (Get_Design_File_Filename (Design_File)) - & " has changed and must be reanalysed", Loc); - raise Compilation_Error; - elsif Get_Date (Design_Unit) = Date_Obsolete then - Error_Msg_Sem - (''' & Disp_Node (Get_Library_Unit (Design_Unit)) - & "' is not anymore in the file", - Design_Unit); - raise Compilation_Error; - end if; - Pos := Get_Design_Unit_Source_Pos (Design_Unit); - Line := Natural (Get_Design_Unit_Source_Line (Design_Unit)); - Off := Natural (Get_Design_Unit_Source_Col (Design_Unit)); - Files_Map.File_Add_Line_Number (Get_Current_Source_File, Line, Pos); - Set_Current_Position (Pos + Source_Ptr (Off)); - Res := Parse.Parse_Design_Unit; - Close_File; - if Res = Null_Iir then - raise Compilation_Error; - end if; - Set_Date_State (Design_Unit, Date_Parse); - -- FIXME: check the library unit read is the one expected. - -- Copy node. - Iirs_Utils.Free_Recursive (Get_Library_Unit (Design_Unit)); - Set_Library_Unit (Design_Unit, Get_Library_Unit (Res)); - Set_Design_Unit (Get_Library_Unit (Res), Design_Unit); - Set_Parent (Get_Library_Unit (Res), Design_Unit); - Set_Context_Items (Design_Unit, Get_Context_Items (Res)); - Location_Copy (Design_Unit, Res); - Free_Dependence_List (Design_Unit); - Set_Dependence_List (Design_Unit, Get_Dependence_List (Res)); - Set_Dependence_List (Res, Null_Iir_List); - Free_Iir (Res); - end Load_Parse_Design_Unit; - - -- Load, parse, semantize, back-end a design_unit if necessary. - procedure Load_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir) is - begin - if Get_Date_State (Design_Unit) = Date_Disk then - Load_Parse_Design_Unit (Design_Unit, Loc); - end if; - - if Get_Date_State (Design_Unit) = Date_Parse then - -- Analyze the design unit. - - if Get_Date (Design_Unit) = Date_Analyzed then - -- Work-around for an internal check in sem. - -- FIXME: to be removed ? - Set_Date (Design_Unit, Date_Parsed); - end if; - - -- Avoid infinite recursion, if the unit is self-referenced. - Set_Date_State (Design_Unit, Date_Analyze); - - Sem_Scopes.Push_Interpretations; - Back_End.Finish_Compilation (Design_Unit); - Sem_Scopes.Pop_Interpretations; - - end if; - - case Get_Date (Design_Unit) is - when Date_Parsed => - raise Internal_Error; - when Date_Analyzing => - -- Self-referenced unit. - return; - when Date_Analyzed => - -- FIXME: Accept it silently ? - -- Note: this is used when Flag_Elaborate_With_Outdated is set. - -- This is also used by anonymous configuration declaration. - null; - when Date_Uptodate => - return; - when Date_Valid => - null; - when Date_Obsolete => - if not Flags.Flag_Elaborate_With_Outdated then - Error_Msg_Sem (Disp_Node (Design_Unit) & " is obsolete", Loc); - return; - end if; - when others => - raise Internal_Error; - end case; - - if not Flags.Flag_Elaborate_With_Outdated - and then Is_Obsolete (Design_Unit, Loc) - then - Set_Date (Design_Unit, Date_Obsolete); - end if; - end Load_Design_Unit; - - -- Return the declaration of primary unit NAME of LIBRARY. - function Find_Primary_Unit - (Library: Iir_Library_Declaration; Name: Name_Id) - return Iir_Design_Unit - is - Unit : Iir_Design_Unit; - begin - Unit := Unit_Hash_Table (Name mod Unit_Hash_Length); - while Unit /= Null_Iir loop - if Get_Identifier (Unit) = Name - and then Get_Library (Get_Design_File (Unit)) = Library - then - case Get_Kind (Get_Library_Unit (Unit)) is - when Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Configuration_Declaration => - -- Only return a primary unit. - return Unit; - when Iir_Kind_Package_Body - | Iir_Kind_Architecture_Body => - null; - when others => - raise Internal_Error; - end case; - end if; - Unit := Get_Hash_Chain (Unit); - end loop; - - -- The primary unit is not in the library, return null. - return Null_Iir; - end Find_Primary_Unit; - - function Load_Primary_Unit - (Library: Iir_Library_Declaration; Name: Name_Id; Loc : Iir) - return Iir_Design_Unit - is - Design_Unit: Iir_Design_Unit; - begin - Design_Unit := Find_Primary_Unit (Library, Name); - if Design_Unit /= Null_Iir then - Load_Design_Unit (Design_Unit, Loc); - end if; - return Design_Unit; - end Load_Primary_Unit; - - -- Return the declaration of secondary unit NAME for PRIMARY, or null if - -- not found. - function Find_Secondary_Unit (Primary: Iir_Design_Unit; Name: Name_Id) - return Iir_Design_Unit - is - Design_Unit: Iir_Design_Unit; - Library_Unit: Iir; - Primary_Ident: Name_Id; - Lib_Prim : Iir; - begin - Lib_Prim := Get_Library (Get_Design_File (Primary)); - Primary_Ident := Get_Identifier (Get_Library_Unit (Primary)); - Design_Unit := Unit_Hash_Table (Primary_Ident mod Unit_Hash_Length); - while Design_Unit /= Null_Iir loop - Library_Unit := Get_Library_Unit (Design_Unit); - - -- The secondary is always in the same library as the primary. - if Get_Library (Get_Design_File (Design_Unit)) = Lib_Prim then - -- Set design_unit to null iff this is not the correct - -- design unit. - case Get_Kind (Library_Unit) is - when Iir_Kind_Architecture_Body => - -- The entity field can be either an identifier (if the - -- library unit was not loaded) or an access to the entity - -- unit. - if (Get_Entity_Identifier_Of_Architecture (Library_Unit) - = Primary_Ident) - and then Get_Identifier (Library_Unit) = Name - then - return Design_Unit; - end if; - when Iir_Kind_Package_Body => - if Name = Null_Identifier - and then Get_Identifier (Library_Unit) = Primary_Ident - then - return Design_Unit; - end if; - when others => - null; - end case; - end if; - Design_Unit := Get_Hash_Chain (Design_Unit); - end loop; - - -- The architecture or the body is not in the library, return null. - return Null_Iir; - end Find_Secondary_Unit; - - -- Load an secondary unit and analyse it. - function Load_Secondary_Unit - (Primary: Iir_Design_Unit; Name: Name_Id; Loc : Iir) - return Iir_Design_Unit - is - Design_Unit: Iir_Design_Unit; - begin - Design_Unit := Find_Secondary_Unit (Primary, Name); - if Design_Unit /= Null_Iir then - Load_Design_Unit (Design_Unit, Loc); - end if; - return Design_Unit; - end Load_Secondary_Unit; - - function Find_Entity_For_Component (Name: Name_Id) return Iir_Design_Unit - is - Res : Iir_Design_Unit := Null_Iir; - Unit : Iir_Design_Unit; - begin - Unit := Unit_Hash_Table (Name mod Unit_Hash_Length); - while Unit /= Null_Iir loop - if Get_Identifier (Unit) = Name - and then (Get_Kind (Get_Library_Unit (Unit)) - = Iir_Kind_Entity_Declaration) - then - if Res = Null_Iir then - Res := Unit; - else - -- Many entities. - return Null_Iir; - end if; - end if; - Unit := Get_Hash_Chain (Unit); - end loop; - - return Res; - end Find_Entity_For_Component; - - function Get_Libraries_Chain return Iir_Library_Declaration is - begin - return Libraries_Chain; - end Get_Libraries_Chain; -end Libraries; diff --git a/libraries.ads b/libraries.ads deleted file mode 100644 index ecb048c94..000000000 --- a/libraries.ads +++ /dev/null @@ -1,188 +0,0 @@ --- VHDL libraries handling. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Types; use Types; -with Iirs; use Iirs; -with Std_Names; - -package Libraries is - -- This package defines the library manager. - -- The purpose of the library manager is to associate library logical names - -- with host-dependent library. - -- - -- In this implementation a host-dependent library is a file, whose name - -- is logical name of the library with the extension '.cf'. This file - -- contains the name and the position (filename, line, column and offset) - -- of all library unit of the library. - -- - -- The working library WORK can be aliased with a ressource library, - -- they share the same host-dependenet library whose name is the name - -- of the ressource library. This is done by load_work_library. - - -- Location for a command line. - Command_Line_Location : Location_Type; - - -- Library declaration for the std library. - -- This is also the first library of the libraries chain. - Std_Library : Iir_Library_Declaration := Null_Iir; - - -- Library declaration for the work library. - -- Note: the identifier of the work_library is work_library_name, which - -- may be different from 'WORK'. - Work_Library: Iir_Library_Declaration; - - -- Name of the WORK library. - Work_Library_Name : Name_Id := Std_Names.Name_Work; - - -- Directory of the work library. - -- Set by default by INIT_PATHES to the local directory. - Work_Directory : Name_Id; - - -- Local (current) directory. - Local_Directory : Name_Id; - - -- Correspond to "" (empty identifier). Used to denote current directory - -- for library directories. - Name_Nil : Name_Id; - - -- Chain of obsoleted design units. - Obsoleted_Design_Units : Iir := Null_Iir; - - -- Initialize library pathes table. - -- Set the local path. - procedure Init_Pathes; - - -- Add PATH in the search path. - procedure Add_Library_Path (Path : String); - - -- Get the number of path in the search pathes. - function Get_Nbr_Pathes return Natural; - - -- Get path N. - function Get_Path (N : Natural) return Name_Id; - - -- Set PATH as the path of the work library. - procedure Set_Work_Library_Path (Path : String); - - -- Set the name of the work library, load the work library. - -- Note: the scanner shouldn't be in use, since this function uses it. - -- If EMPTY is set, the work library is just created and not loaded. - procedure Load_Work_Library (Empty : Boolean := False); - - -- Initialize the library manager and load the STD library. - -- If BUILD_STANDARD is false, the std.standard library is not created. - procedure Load_Std_Library (Build_Standard : Boolean := True); - - -- Save the work library as a host-dependent library. - procedure Save_Work_Library; - - -- Start the analyse a file (ie load and parse it). - -- The file is read from the current directory (unless FILE_NAME is an - -- absolute path). - -- Emit an error if the file cannot be opened. - -- Return NULL_IIR in case of parse error. - function Load_File (File_Name: Name_Id) return Iir_Design_File; - function Load_File (File : Source_File_Entry) return Iir_Design_File; - - -- Load, parse, semantize, back-end a design_unit if necessary. - -- Check Design_Unit is not obsolete. - -- LOC is the location where the design unit was needed, in case of error. - procedure Load_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir); - - -- Load and parse DESIGN_UNIT. - -- Contrary to Load_Design_Unit, the design_unit is not analyzed. - -- Also, the design_unit must not have been already loaded. - -- Used almost only by Load_Design_Unit. - procedure Load_Parse_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir); - - -- Remove the same file as DESIGN_FILE from work library and all of its - -- units. - procedure Purge_Design_File (Design_File : Iir_Design_File); - - -- Just return the design_unit for NAME, or NULL if not found. - function Find_Primary_Unit - (Library: Iir_Library_Declaration; Name: Name_Id) - return Iir_Design_Unit; - - -- Load an already analyzed primary unit NAME from library LIBRARY - -- and compile it. - -- Return NULL_IIR if not found (ie, NAME does not correspond to a - -- library unit identifier). - function Load_Primary_Unit - (Library: Iir_Library_Declaration; Name: Name_Id; Loc : Iir) - return Iir_Design_Unit; - - -- Find the secondary unit of PRIMARY. - -- If PRIMARY is a package declaration, returns the package body, - -- If PRIMARY is an entity declaration, returns the architecture NAME. - -- Return NULL_IIR if not found. - function Find_Secondary_Unit (Primary: Iir_Design_Unit; Name: Name_Id) - return Iir_Design_Unit; - - -- Load an secondary unit of primary unit PRIMARY and analyse it. - -- NAME must be set only for an architecture. - function Load_Secondary_Unit - (Primary: Iir_Design_Unit; Name: Name_Id; Loc : Iir) - return Iir_Design_Unit; - - -- Get or create a library from an identifier. - -- LOC is used only to report errors. - function Get_Library (Ident : Name_Id; Loc : Location_Type) - return Iir_Library_Declaration; - - -- Add or replace an design unit in the work library. - -- DECL must not have a chain (because it may be modified). - -- - -- If the design_file of UNIT is not already in the library, a new one - -- is created. - -- - -- Units are always appended to the design_file. Therefore, the order is - -- kept. - -- - -- If KEEP_OBSOLETE is True, obsoleted units are kept in the library. - -- This is used when a whole design file has to be added in the library and - -- then processed (without that feature, redefined units would disappear). - procedure Add_Design_Unit_Into_Library - (Unit : in Iir_Design_Unit; Keep_Obsolete : Boolean := False); - - -- Put all design_units of FILE into the work library, by calling - -- Add_Design_Unit_Into_Library. - -- FILE is updated since it may changed (FILE is never put in the library, - -- a new one is created). - procedure Add_Design_File_Into_Library (File : in out Iir_Design_File); - - -- Return the latest architecture analysed for entity ENTITY. - function Get_Latest_Architecture (Entity: Iir_Entity_Declaration) - return Iir_Architecture_Body; - - -- Return the design unit (stubed if not loaded) from UNIT. - -- UNIT may be either a design unit, in this case UNIT is returned, - -- or a selected name, in this case the prefix is a library name and - -- the suffix a primary design unit name, - -- or an entity_aspect_entity to designate an architectrure. - -- Return null_iir if the design unit is not found. - function Find_Design_Unit (Unit : Iir) return Iir_Design_Unit; - - -- Find an entity whose name is NAME in any library. - -- If there is no such entity, return NULL_IIR. - -- If there are severals entities, return NULL_IIR; - function Find_Entity_For_Component (Name: Name_Id) return Iir_Design_Unit; - - -- Get the chain of libraries. Can be used only to read (it musn't be - -- modified). - function Get_Libraries_Chain return Iir_Library_Declaration; -end Libraries; diff --git a/lists.adb b/lists.adb deleted file mode 100644 index 38afea595..000000000 --- a/lists.adb +++ /dev/null @@ -1,257 +0,0 @@ --- Lists data type. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with System; -with GNAT.Table; - -package body Lists is - type Node_Array_Fat is array (Natural) of Node_Type; - type Node_Array_Fat_Acc is access Node_Array_Fat; - - type List_Record is record - Max : Natural; - Nbr : Natural; - Next : List_Type; - Els : Node_Array_Fat_Acc; - end record; - - package Listt is new GNAT.Table - (Table_Component_Type => List_Record, - Table_Index_Type => List_Type, - Table_Low_Bound => 4, - Table_Initial => 128, - Table_Increment => 100); - - --function Get_Max_Nbr_Elements (List : List_Type) return Natural; - --pragma Inline (Get_Max_Nbr_Elements); - - --procedure Set_Max_Nbr_Elements (List : List_Type; Max : Natural); - --pragma Inline (Set_Max_Nbr_Elements); - - procedure List_Set_Nbr_Elements (List : List_Type; Nbr : Natural); - pragma Inline (List_Set_Nbr_Elements); - - function Get_Nbr_Elements (List: List_Type) return Natural is - begin - return Listt.Table (List).Nbr; - end Get_Nbr_Elements; - - procedure List_Set_Nbr_Elements (List : List_Type; Nbr : Natural) is - begin - Listt.Table (List).Nbr := Nbr; - end List_Set_Nbr_Elements; - - --function Get_Max_Nbr_Elements (List : List_Type) return Natural is - --begin - -- return Listt.Table (List).Max; - --end Get_Max_Nbr_Elements; - - --procedure Set_Max_Nbr_Elements (List : List_Type; Max : Natural) is - --begin - -- Listt.Table (List).Max := Max; - --end Set_Max_Nbr_Elements; - - function Get_Nth_Element (List: List_Type; N: Natural) - return Node_Type - is - begin - if N >= Listt.Table (List).Nbr then - return Null_Node; - end if; - return Listt.Table (List).Els (N); - end Get_Nth_Element; - - -- Replace an element selected by position. - procedure Replace_Nth_Element (List: List_Type; N: Natural; El: Node_Type) - is - begin - if N >= Listt.Table (List).Nbr then - raise Program_Error; - end if; - Listt.Table (List).Els (N) := El; - end Replace_Nth_Element; - - -- Be sure an element can be added to LIST. - -- It doesn't change the number of elements. - procedure List_Grow (List: List_Type) - is - L : List_Record renames Listt.Table (List); - - -- Be careful: size in bytes. - function Alloc (Size : Natural) return Node_Array_Fat_Acc; - pragma Import (C, Alloc, "malloc"); - - function Realloc (Ptr : Node_Array_Fat_Acc; Size : Natural) - return Node_Array_Fat_Acc; - pragma Import (C, Realloc, "realloc"); - - Tmp : Node_Array_Fat_Acc; - N : Natural; - begin - if L.Nbr < L.Max then - return; - end if; - if L.Max = 0 then - N := 8; - Tmp := Alloc (N * Node_Type'Size / System.Storage_Unit); - else - N := L.Max * 2; - Tmp := Realloc (L.Els, N * Node_Type'Size / System.Storage_Unit); - end if; - L.Els := Tmp; - L.Max := N; - end List_Grow; - - procedure Append_Element (List: List_Type; Element: Node_Type) - is - L : List_Record renames Listt.Table (List); - begin - if L.Nbr >= L.Max then - List_Grow (List); - end if; - L.Els (L.Nbr) := Element; - L.Nbr := L.Nbr + 1; - end Append_Element; - - -- Return the last element of the list, or null. - function Get_Last_Element (List: List_Type) return Node_Type - is - L : List_Record renames Listt.Table (List); - begin - if L.Nbr = 0 then - return Null_Node; - else - return L.Els (L.Nbr - 1); - end if; - end Get_Last_Element; - - -- Return the first element of the list, or null. - function Get_First_Element (List: List_Type) return Node_Type is - begin - if Listt.Table (List).Nbr = 0 then - return Null_Node; - else - return Listt.Table (List).Els (0); - end if; - end Get_First_Element; - - -- Add (append) an element only if it was not already present in the list. - procedure Add_Element (List: List_Type; El: Node_Type) - is - Nbr : constant Natural := Get_Nbr_Elements (List); - begin - for I in 0 .. Nbr - 1 loop - if Listt.Table (List).Els (I) = El then - return; - end if; - end loop; - - Append_Element (List, El); - end Add_Element; - - procedure Remove_Nth_Element (List: List_Type; N: Natural) - is - Nbr : constant Natural := Get_Nbr_Elements (List); - begin - if N >= Nbr then - raise Program_Error; - end if; - for I in N .. Nbr - 2 loop - Listt.Table (List).Els (I) := Listt.Table (List).Els (I + 1); - end loop; - Listt.Table (List).Nbr := Nbr - 1; - end Remove_Nth_Element; - - procedure Set_Nbr_Elements (List: List_Type; N: Natural) is - begin - if N > Get_Nbr_Elements (List) then - raise Program_Error; - end if; - List_Set_Nbr_Elements (List, N); - end Set_Nbr_Elements; - - -- Return the position of the last element. - -- Return -1 if the list is empty. - function Get_Last_Element_Position (List: List_Type) return Integer is - begin - return Get_Nbr_Elements (List) - 1; - end Get_Last_Element_Position; - - function Get_Nbr_Elements_Safe (List: List_Type) return Natural is - begin - if List = Null_List then - return 0; - else - return Get_Nbr_Elements (List); - end if; - end Get_Nbr_Elements_Safe; - - -- Empty the list - procedure Empty_List (List: List_Type) is - begin - Set_Nbr_Elements (List, 0); - end Empty_List; - - -- Chain of unused lists. - Free_Chain : List_Type := Null_List; - - function Create_List return List_Type - is - Res : List_Type; - begin - if Free_Chain = Null_List then - Listt.Increment_Last; - Res := Listt.Last; - else - Res := Free_Chain; - Free_Chain := Listt.Table (Res).Next; - end if; - Listt.Table (Res) := List_Record'(Max => 0, Nbr => 0, - Next => Null_List, Els => null); - return Res; - end Create_List; - - procedure Free (Ptr : Node_Array_Fat_Acc); - pragma Import (C, Free, "free"); - - procedure Destroy_List (List : in out List_Type) - is - begin - if List = Null_List then - return; - end if; - if Listt.Table (List).Max > 0 then - Free (Listt.Table (List).Els); - Listt.Table (List).Els := null; - end if; - Listt.Table (List).Next := Free_Chain; - Free_Chain := List; - List := Null_List; - end Destroy_List; - - procedure Initialize is - begin - for I in Listt.First .. Listt.Last loop - if Listt.Table (I).Els /= null then - Free (Listt.Table (I).Els); - end if; - end loop; - Listt.Free; - Listt.Init; - end Initialize; - -end Lists; diff --git a/lists.ads b/lists.ads deleted file mode 100644 index 7645e3403..000000000 --- a/lists.ads +++ /dev/null @@ -1,123 +0,0 @@ --- Lists data type. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Types; use Types; -with Nodes; use Nodes; - -package Lists is - type List_Type is new Nat32; - for List_Type'Size use 32; - - Null_List : constant List_Type := 0; - - List_Others : constant List_Type := 1; - List_All : constant List_Type := 2; - - ----------- - -- Lists -- - ----------- - - -- Iir_Kinds_List - -- Lists of elements. - -- index is 0 .. nbr_elements - 1. - -- - -- Append an element to (the end of) the list. - -- procedure Append_Element (List: in Iir; Element: Iir); - -- - -- Get the N th element in list, starting from 0. - -- Return an access to the element or null_iir, if beyond bounds. - -- function Get_Nth_Element (List: in Iir; N: Natural) return Iir; - -- - -- Return the last element of the list, or null_iir. - -- function Get_Last_Element (List: in Iir) return Iir; - -- - -- Return the first element of the list, or null_iir. - -- function Get_First_Element (List: in Iir) return Iir; - -- - -- Replace an element selected by position. - -- procedure Replace_Nth_Element (List: in Iir_List; N: Natural; El:Iir); - -- - -- Add (append) an element only if it was not already present in the list. - -- Return its position. - -- procedure Add_Element (List: in Iir; El: Iir; Position: out integer); - -- procedure Add_Element (List: in Iir_List; El: Iir); - -- - -- Return the number of elements in the list. - -- This is also 1 + the position of the last element. - -- function Get_Nbr_Elements (List: in Iir_List) return Natural; - -- - -- Set the number of elements in the list. - -- Can be used only to shrink the list. - -- procedure Set_Nbr_Elements (List: in Iir_List; N: Natural); - -- - -- Remove an element from the list. - -- procedure remove_Nth_Element (List: in Iir_List; N: Natural); - -- - -- Return the position of the last element. - -- Return -1 if the list is empty. - -- function Get_Last_Element_Position (List: in Iir_List) return Integer; - -- - -- Empty the list. - -- This is also set_nbr_elements (list, 0); - -- procedure Empty_List (List: in Iir_List); - -- - -- Alias a list. TARGET must be empty. - -- procedure Alias_List (Target: in out Iir; Source: in Iir); - - procedure Append_Element (List: List_Type; Element: Node_Type); - - -- Get the N th element in list, starting from 0. - -- Return the element or null_iir, if beyond bounds. - function Get_Nth_Element (List: List_Type; N: Natural) return Node_Type; - - function Get_Last_Element (List: List_Type) return Node_Type; - - function Get_First_Element (List: List_Type) return Node_Type; - - procedure Replace_Nth_Element (List: List_Type; N: Natural; El: Node_Type); - - procedure Add_Element (List: List_Type; El: Node_Type); - - -- Return the number of elements in the list. - -- This is also 1 + the position of the last element. - function Get_Nbr_Elements (List: List_Type) return Natural; - pragma Inline (Get_Nbr_Elements); - - -- Same as get_nbr_elements but returns 0 if LIST is NULL_IIR. - function Get_Nbr_Elements_Safe (List : List_Type) return Natural; - - -- Set the number of elements in the list. - -- Can be used only to shrink the list. - procedure Set_Nbr_Elements (List: List_Type; N: Natural); - - procedure Remove_Nth_Element (List : List_Type; N: Natural); - - function Get_Last_Element_Position (List: List_Type) return Integer; - - -- Clear the list. - procedure Empty_List (List: List_Type); - - -- Create a list. - function Create_List return List_Type; - - -- Destroy a list. - procedure Destroy_List (List : in out List_Type); - - -- Free all the lists and reset to initial state. - -- Must be used to free the memory used by the lists. - procedure Initialize; -end Lists; diff --git a/name_table.adb b/name_table.adb deleted file mode 100644 index af60ec0b7..000000000 --- a/name_table.adb +++ /dev/null @@ -1,359 +0,0 @@ --- Name table. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Ada.Text_IO; use Ada.Text_IO; -with GNAT.Table; - -package body Name_Table is - -- A flag that creates verbosity. - Debug_Name_Table: constant Boolean := False; - - First_Character_Name_Id : constant Name_Id := 1; - - type Hash_Value_Type is mod 2**32; - - -- An entry in the name table. - type Identifier is record - Hash: Hash_Value_Type; - Next: Name_Id; - - -- FIXME: to be removed (compute from name of next identifier). - Length: Natural; - - -- Index in strings_table. - Name: Natural; - - -- User infos. - Info: Int32; - end record; - - -- Hash table. - -- Number of entry points. - Hash_Table_Size: constant Hash_Value_Type := 1024; - Hash_Table: array (0 .. Hash_Table_Size - 1) of Name_Id; - - -- The table to store all the strings. - package Strings_Table is new GNAT.Table - (Table_Index_Type => Natural, - Table_Component_Type => Character, - Table_Low_Bound => Natural'First, - Table_Initial => 4096, - Table_Increment => 100); - - -- A NUL character is stored after each word in the strings_table. - -- This is used for compatibility with C. - NUL: constant Character := Character'Val (0); - - -- Allocate place in the strings_table, and store the name_buffer into it. - -- Also append a NUL. - function Store return Natural is - Res: Natural; - begin - Res := Strings_Table.Allocate (Name_Length + 1); - Strings_Table.Table (Res .. Res + Name_Length - 1) := - Strings_Table.Table_Type (Name_Buffer (1 .. Name_Length)); - Strings_Table.Table (Res + Name_Length) := NUL; - return Res; - end Store; - - package Names_Table is new GNAT.Table - (Table_Index_Type => Name_Id, - Table_Component_Type => Identifier, - Table_Low_Bound => Name_Id'First, - Table_Initial => 1024, - Table_Increment => 100); - - -- Initialize this package - -- This must be called once and only once before any use. - procedure Initialize is - Pos: Natural; - Id: Name_Id; - begin - Strings_Table.Init; - Names_Table.Init; - -- Reserve entry 0. - if Names_Table.Allocate /= Null_Identifier then - raise Program_Error; - end if; - Strings_Table.Set_Last (1); - Names_Table.Table (Null_Identifier) := (Length => 0, - Hash => 0, - Name => 1, - Next => Null_Identifier, - Info => 0); - -- Store characters. - for C in Character loop - Pos := Strings_Table.Allocate; - Strings_Table.Table (Pos) := C; - Id := Names_Table.Allocate; - Names_Table.Table (Id) := (Length => 1, - Hash => 0, - Name => Pos, - Next => Null_Identifier, - Info => 0); - end loop; - Hash_Table := (others => Null_Identifier); - end Initialize; - - -- Compute the hash value of a string. - function Hash return Hash_Value_Type is - Res: Hash_Value_Type := 0; - begin - for I in 1 .. Name_Length loop - Res := Res * 7 + Character'Pos(Name_Buffer(I)); - Res := Res + Res / 2**28; - end loop; - return Res; - end Hash; - - -- Get the string associed to an identifier. - function Image (Id: Name_Id) return String is - Name_Entry: Identifier renames Names_Table.Table(Id); - subtype Result_Type is String (1 .. Name_Entry.Length); - begin - if Is_Character (Id) then - return ''' & Strings_Table.Table (Name_Entry.Name) & '''; - else - return Result_Type - (Strings_Table.Table - (Name_Entry.Name .. Name_Entry.Name + Name_Entry.Length - 1)); - end if; - end Image; - - procedure Image (Id : Name_Id) - is - Name_Entry: Identifier renames Names_Table.Table(Id); - begin - if Is_Character (Id) then - Name_Buffer (1) := Get_Character (Id); - Name_Length := 1; - else - Name_Length := Name_Entry.Length; - Name_Buffer (1 .. Name_Entry.Length) := String - (Strings_Table.Table - (Name_Entry.Name .. Name_Entry.Name + Name_Entry.Length - 1)); - end if; - end Image; - - -- Get the address of the first character of ID. - -- The string is NUL-terminated (this is done by get_identifier). - function Get_Address (Id: Name_Id) return System.Address is - Name_Entry: Identifier renames Names_Table.Table(Id); - begin - return Strings_Table.Table (Name_Entry.Name)'Address; - end Get_Address; - - function Get_Name_Length (Id: Name_Id) return Natural is - begin - return Names_Table.Table(Id).Length; - end Get_Name_Length; - - function Is_Character (Id: Name_Id) return Boolean is - begin - return Id >= First_Character_Name_Id and then - Id <= First_Character_Name_Id + Character'Pos (Character'Last); - end Is_Character; - - -- Get the character associed to an identifier. - function Get_Character (Id: Name_Id) return Character is - begin - pragma Assert (Is_Character (Id)); - return Character'Val (Id - First_Character_Name_Id); - end Get_Character; - - -- Get and set the info field associated with each identifier. - -- Used to store interpretations of the name. - function Get_Info (Id: Name_Id) return Int32 is - begin - return Names_Table.Table (Id).Info; - end Get_Info; - - procedure Set_Info (Id: Name_Id; Info: Int32) is - begin - Names_Table.Table (Id).Info := Info; - end Set_Info; - - function Compare_Name_Buffer_With_Name (Id : Name_Id) return Boolean - is - Ne: Identifier renames Names_Table.Table(Id); - begin - return String (Strings_Table.Table (Ne.Name .. Ne.Name + Ne.Length - 1)) - = Name_Buffer (1 .. Name_Length); - end Compare_Name_Buffer_With_Name; - - -- Get or create an entry in the name table. - -- The string is taken from NAME_BUFFER and NAME_LENGTH. - function Get_Identifier return Name_Id - is - Hash_Value, Hash_Index: Hash_Value_Type; - Res: Name_Id; - begin - Hash_Value := Hash; - Hash_Index := Hash_Value mod Hash_Table_Size; - - if Debug_Name_Table then - Put_Line ("get_identifier " & Name_Buffer (1 .. Name_Length)); - end if; - - Res := Hash_Table (Hash_Index); - while Res /= Null_Identifier loop - --Put_Line ("compare with " & Get_String (Res)); - if Names_Table.Table (Res).Hash = Hash_Value - and then Names_Table.Table (Res).Length = Name_Length - and then Compare_Name_Buffer_With_Name (Res) - then - --Put_Line ("found"); - return Res; - end if; - Res := Names_Table.Table (Res).Next; - end loop; - Res := Names_Table.Allocate; - Names_Table.Table (Res) := (Length => Name_Length, - Hash => Hash_Value, - Name => Store, - Next => Hash_Table (Hash_Index), - Info => 0); - Hash_Table (Hash_Index) := Res; - --Put_Line ("created"); - return Res; - end Get_Identifier; - - function Get_Identifier_No_Create return Name_Id - is - Hash_Value, Hash_Index: Hash_Value_Type; - Res: Name_Id; - begin - Hash_Value := Hash; - Hash_Index := Hash_Value mod Hash_Table_Size; - - Res := Hash_Table (Hash_Index); - while Res /= Null_Identifier loop - if Names_Table.Table (Res).Hash = Hash_Value - and then Names_Table.Table (Res).Length = Name_Length - and then Compare_Name_Buffer_With_Name (Res) - then - return Res; - end if; - Res := Names_Table.Table (Res).Next; - end loop; - return Null_Identifier; - end Get_Identifier_No_Create; - - -- Get or create an entry in the name table. - function Get_Identifier (Str: String) return Name_Id is - begin - Name_Length := Str'Length; - Name_Buffer (1 .. Name_Length) := Str; - return Get_Identifier; - end Get_Identifier; - - function Get_Identifier (Char: Character) return Name_Id is - begin - return First_Character_Name_Id + Character'Pos (Char); - end Get_Identifier; - - -- Be sure all info fields have their default value. - procedure Assert_No_Infos is - Err: Boolean := False; - begin - for I in Names_Table.First .. Names_Table.Last loop - if Get_Info (I) /= 0 then - Err := True; - Put_Line ("still infos in" & Name_Id'Image (I) & ", ie: " - & Image (I) & ", info =" - & Int32'Image (Names_Table.Table (I).Info)); - end if; - end loop; - if Err then - raise Program_Error; - end if; - end Assert_No_Infos; - - -- Return the latest name_id used. - -- kludge, use only for debugging. - function Last_Name_Id return Name_Id is - begin - return Names_Table.Last; - end Last_Name_Id; - - -- Used to debug. - -- Disp the strings table, one word per line. - procedure Dump; - pragma Unreferenced (Dump); - - procedure Dump - is - First: Natural; - begin - Put_Line ("strings_table:"); - First := 0; - for I in 0 .. Strings_Table.Last loop - if Strings_Table.Table(I) = NUL then - Put_Line (Natural'Image (First) & ": " - & String (Strings_Table.Table (First .. I - 1))); - First := I + 1; - end if; - end loop; - end Dump; - - function Get_Hash_Entry_Length (H : Hash_Value_Type) return Natural - is - Res : Natural := 0; - N : Name_Id; - begin - N := Hash_Table (H); - while N /= Null_Identifier loop - Res := Res + 1; - N := Names_Table.Table (N).Next; - end loop; - return Res; - end Get_Hash_Entry_Length; - - procedure Disp_Stats - is - Min : Natural; - Max : Natural; - N : Natural; - begin - Put_Line ("Name table statistics:"); - Put_Line (" number of identifiers: " & Name_Id'Image (Last_Name_Id)); - Put_Line (" size of strings: " & Natural'Image (Strings_Table.Last)); - Put_Line (" hash distribution (number of entries per length):"); - Min := Natural'Last; - Max := Natural'First; - for I in Hash_Table'Range loop - N := Get_Hash_Entry_Length (I); - Min := Natural'Min (Min, N); - Max := Natural'Max (Max, N); - end loop; - declare - type Nat_Array is array (Min .. Max) of Natural; - S : Nat_Array := (others => 0); - begin - for I in Hash_Table'Range loop - N := Get_Hash_Entry_Length (I); - S (N) := S (N) + 1; - end loop; - for I in S'Range loop - if S (I) /= 0 then - Put_Line (" " & Natural'Image (I) - & ":" & Natural'Image (S (I))); - end if; - end loop; - end; - end Disp_Stats; -end Name_Table; diff --git a/name_table.ads b/name_table.ads deleted file mode 100644 index c3d3e72f1..000000000 --- a/name_table.ads +++ /dev/null @@ -1,98 +0,0 @@ --- Name table. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with System; -with Types; use Types; - --- A very simple name table. --- This is an hash table, such as id1=id2 <=> get_string(id1)=get_string(id2). - -package Name_Table is - -- Initialize the package, ie create tables. - procedure Initialize; - - -- Get an entry in the name table. - -- (entries for characters are already built). - function Get_Identifier (Char: Character) return Name_Id; - pragma Inline (Get_Identifier); - - -- Get or create an entry in the name table. - -- If an entry is created, its token value is tok_identifier. - -- Note: - -- an identifier is represented in all lower case letter, - -- an extended identifier is represented in backslashes, double internal - -- backslashes are simplified, - -- a string is represented by its contents (without the quotation - -- characters, and simplified), - -- a bit string is represented by its raw contents (no simplification). - function Get_Identifier (Str: String) return Name_Id; - - -- Get the string associed to a name. - -- If the name is a character, then single quote are added. - function Image (Id: Name_Id) return String; - - -- Get the address of the first character of ID. - -- The string is NUL-terminated (this is done by get_identifier). - function Get_Address (Id: Name_Id) return System.Address; - - -- Get the length of ID. - function Get_Name_Length (Id: Name_Id) return Natural; - pragma Inline (Get_Name_Length); - - -- Get the character associed to a name. - function Get_Character (Id: Name_Id) return Character; - pragma Inline (Get_Character); - - -- Return TRUE iff ID is a character. - function Is_Character (Id: Name_Id) return Boolean; - pragma Inline (Is_Character); - - -- Get or create an entry in the name table, use NAME_BUFFER/NAME_LENGTH. - function Get_Identifier return Name_Id; - - -- Like GET_IDENTIFIER, but return NULL_IDENTIFIER if the identifier - -- is not found (and do not create an entry for it). - function Get_Identifier_No_Create return Name_Id; - - -- Set NAME_BUFFER/NAME_LENGTH with the image of ID. - procedure Image (Id : Name_Id); - - -- Get and set the info field associated with each identifier. - -- Used to store interpretations of the name. - function Get_Info (Id: Name_Id) return Int32; - pragma Inline (Get_Info); - procedure Set_Info (Id: Name_Id; Info: Int32); - pragma Inline (Set_Info); - - -- Return the latest name_id used. - -- kludge, use only for debugging. - function Last_Name_Id return Name_Id; - - -- Be sure all info fields have their default value. - procedure Assert_No_Infos; - - -- This buffer is used by get_token to set the name. - -- This can be seen as a copy buffer but this is necessary for two reasons: - -- names case must be 'normalized', because VHDL is case insensitive. - Name_Buffer : String (1 .. 1024); - -- The length of the name string. - Name_Length: Natural; - - -- Disp statistics. - -- Used for debugging. - procedure Disp_Stats; -end Name_Table; diff --git a/nodes.adb b/nodes.adb deleted file mode 100644 index 2dc7736ce..000000000 --- a/nodes.adb +++ /dev/null @@ -1,467 +0,0 @@ --- Internal node type and operations. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with GNAT.Table; - -package body Nodes is - -- Suppress the access check of the table base. This is really safe to - -- suppress this check because the table base cannot be null. - pragma Suppress (Access_Check); - - -- Suppress the index check on the table. - -- Could be done during non-debug, since this may catch errors (reading - -- Null_Node or Error_Node). - --pragma Suppress (Index_Check); - - -- Suppress discriminant checks on the table. Relatively safe, since - -- iirs do their own checks. - pragma Suppress (Discriminant_Check); - - package Nodet is new GNAT.Table - (Table_Component_Type => Node_Record, - Table_Index_Type => Node_Type, - Table_Low_Bound => 2, - Table_Initial => 1024, - Table_Increment => 100); - - function Get_Last_Node return Node_Type is - begin - return Nodet.Last; - end Get_Last_Node; - - Free_Chain : Node_Type := Null_Node; - - -- Just to have the default value. - pragma Warnings (Off); - Init_Short : Node_Record (Format_Short); - Init_Medium : Node_Record (Format_Medium); - Init_Fp : Node_Record (Format_Fp); - Init_Int : Node_Record (Format_Int); - pragma Warnings (On); - - function Create_Node (Format : Format_Type) return Node_Type - is - Res : Node_Type; - begin - if Format = Format_Medium then - -- Allocate a first node. - Nodet.Increment_Last; - Res := Nodet.Last; - -- Check alignment. - if Res mod 2 = 1 then - Set_Field1 (Res, Free_Chain); - Free_Chain := Res; - Nodet.Increment_Last; - Res := Nodet.Last; - end if; - -- Allocate the second node. - Nodet.Increment_Last; - Nodet.Table (Res) := Init_Medium; - Nodet.Table (Res + 1) := Init_Medium; - else - -- Check from free pool - if Free_Chain = Null_Node then - Nodet.Increment_Last; - Res := Nodet.Last; - else - Res := Free_Chain; - Free_Chain := Get_Field1 (Res); - end if; - case Format is - when Format_Short => - Nodet.Table (Res) := Init_Short; - when Format_Medium => - raise Program_Error; - when Format_Fp => - Nodet.Table (Res) := Init_Fp; - when Format_Int => - Nodet.Table (Res) := Init_Int; - end case; - end if; - return Res; - end Create_Node; - - procedure Free_Node (N : Node_Type) - is - begin - if N /= Null_Node then - Set_Nkind (N, 0); - Set_Field1 (N, Free_Chain); - Free_Chain := N; - if Nodet.Table (N).Format = Format_Medium then - Set_Field1 (N + 1, Free_Chain); - Free_Chain := N + 1; - end if; - end if; - end Free_Node; - - function Next_Node (N : Node_Type) return Node_Type is - begin - case Nodet.Table (N).Format is - when Format_Medium => - return N + 2; - when Format_Short - | Format_Int - | Format_Fp => - return N + 1; - end case; - end Next_Node; - - function Get_Nkind (N : Node_Type) return Kind_Type is - begin - return Nodet.Table (N).Kind; - end Get_Nkind; - - procedure Set_Nkind (N : Node_Type; Kind : Kind_Type) is - begin - Nodet.Table (N).Kind := Kind; - end Set_Nkind; - - - procedure Set_Location (N : Node_Type; Location: Location_Type) is - begin - Nodet.Table (N).Location := Location; - end Set_Location; - - function Get_Location (N: Node_Type) return Location_Type is - begin - return Nodet.Table (N).Location; - end Get_Location; - - - procedure Set_Field0 (N : Node_Type; V : Node_Type) is - begin - Nodet.Table (N).Field0 := V; - end Set_Field0; - - function Get_Field0 (N : Node_Type) return Node_Type is - begin - return Nodet.Table (N).Field0; - end Get_Field0; - - - function Get_Field1 (N : Node_Type) return Node_Type is - begin - return Nodet.Table (N).Field1; - end Get_Field1; - - procedure Set_Field1 (N : Node_Type; V : Node_Type) is - begin - Nodet.Table (N).Field1 := V; - end Set_Field1; - - function Get_Field2 (N : Node_Type) return Node_Type is - begin - return Nodet.Table (N).Field2; - end Get_Field2; - - procedure Set_Field2 (N : Node_Type; V : Node_Type) is - begin - Nodet.Table (N).Field2 := V; - end Set_Field2; - - function Get_Field3 (N : Node_Type) return Node_Type is - begin - return Nodet.Table (N).Field3; - end Get_Field3; - - procedure Set_Field3 (N : Node_Type; V : Node_Type) is - begin - Nodet.Table (N).Field3 := V; - end Set_Field3; - - function Get_Field4 (N : Node_Type) return Node_Type is - begin - return Nodet.Table (N).Field4; - end Get_Field4; - - procedure Set_Field4 (N : Node_Type; V : Node_Type) is - begin - Nodet.Table (N).Field4 := V; - end Set_Field4; - - function Get_Field5 (N : Node_Type) return Node_Type is - begin - return Nodet.Table (N).Field5; - end Get_Field5; - - procedure Set_Field5 (N : Node_Type; V : Node_Type) is - begin - Nodet.Table (N).Field5 := V; - end Set_Field5; - - function Get_Field6 (N: Node_Type) return Node_Type is - begin - return Node_Type (Nodet.Table (N + 1).Location); - end Get_Field6; - - procedure Set_Field6 (N: Node_Type; Val: Node_Type) is - begin - Nodet.Table (N + 1).Location := Location_Type (Val); - end Set_Field6; - - function Get_Field7 (N: Node_Type) return Node_Type is - begin - return Nodet.Table (N + 1).Field0; - end Get_Field7; - - procedure Set_Field7 (N: Node_Type; Val: Node_Type) is - begin - Nodet.Table (N + 1).Field0 := Val; - end Set_Field7; - - function Get_Field8 (N: Node_Type) return Node_Type is - begin - return Nodet.Table (N + 1).Field1; - end Get_Field8; - - procedure Set_Field8 (N: Node_Type; Val: Node_Type) is - begin - Nodet.Table (N + 1).Field1 := Val; - end Set_Field8; - - function Get_Field9 (N: Node_Type) return Node_Type is - begin - return Nodet.Table (N + 1).Field2; - end Get_Field9; - - procedure Set_Field9 (N: Node_Type; Val: Node_Type) is - begin - Nodet.Table (N + 1).Field2 := Val; - end Set_Field9; - - function Get_Field10 (N: Node_Type) return Node_Type is - begin - return Nodet.Table (N + 1).Field3; - end Get_Field10; - - procedure Set_Field10 (N: Node_Type; Val: Node_Type) is - begin - Nodet.Table (N + 1).Field3 := Val; - end Set_Field10; - - function Get_Field11 (N: Node_Type) return Node_Type is - begin - return Nodet.Table (N + 1).Field4; - end Get_Field11; - - procedure Set_Field11 (N: Node_Type; Val: Node_Type) is - begin - Nodet.Table (N + 1).Field4 := Val; - end Set_Field11; - - function Get_Field12 (N: Node_Type) return Node_Type is - begin - return Nodet.Table (N + 1).Field5; - end Get_Field12; - - procedure Set_Field12 (N: Node_Type; Val: Node_Type) is - begin - Nodet.Table (N + 1).Field5 := Val; - end Set_Field12; - - - function Get_Flag1 (N : Node_Type) return Boolean is - begin - return Nodet.Table (N).Flag1; - end Get_Flag1; - - procedure Set_Flag1 (N : Node_Type; V : Boolean) is - begin - Nodet.Table (N).Flag1 := V; - end Set_Flag1; - - function Get_Flag2 (N : Node_Type) return Boolean is - begin - return Nodet.Table (N).Flag2; - end Get_Flag2; - - procedure Set_Flag2 (N : Node_Type; V : Boolean) is - begin - Nodet.Table (N).Flag2 := V; - end Set_Flag2; - - function Get_Flag3 (N : Node_Type) return Boolean is - begin - return Nodet.Table (N).Flag3; - end Get_Flag3; - - procedure Set_Flag3 (N : Node_Type; V : Boolean) is - begin - Nodet.Table (N).Flag3 := V; - end Set_Flag3; - - function Get_Flag4 (N : Node_Type) return Boolean is - begin - return Nodet.Table (N).Flag4; - end Get_Flag4; - - procedure Set_Flag4 (N : Node_Type; V : Boolean) is - begin - Nodet.Table (N).Flag4 := V; - end Set_Flag4; - - function Get_Flag5 (N : Node_Type) return Boolean is - begin - return Nodet.Table (N).Flag5; - end Get_Flag5; - - procedure Set_Flag5 (N : Node_Type; V : Boolean) is - begin - Nodet.Table (N).Flag5 := V; - end Set_Flag5; - - function Get_Flag6 (N : Node_Type) return Boolean is - begin - return Nodet.Table (N).Flag6; - end Get_Flag6; - - procedure Set_Flag6 (N : Node_Type; V : Boolean) is - begin - Nodet.Table (N).Flag6 := V; - end Set_Flag6; - - function Get_Flag7 (N : Node_Type) return Boolean is - begin - return Nodet.Table (N).Flag7; - end Get_Flag7; - - procedure Set_Flag7 (N : Node_Type; V : Boolean) is - begin - Nodet.Table (N).Flag7 := V; - end Set_Flag7; - - function Get_Flag8 (N : Node_Type) return Boolean is - begin - return Nodet.Table (N).Flag8; - end Get_Flag8; - - procedure Set_Flag8 (N : Node_Type; V : Boolean) is - begin - Nodet.Table (N).Flag8 := V; - end Set_Flag8; - - function Get_Flag9 (N : Node_Type) return Boolean is - begin - return Nodet.Table (N).Flag9; - end Get_Flag9; - - procedure Set_Flag9 (N : Node_Type; V : Boolean) is - begin - Nodet.Table (N).Flag9 := V; - end Set_Flag9; - - function Get_Flag10 (N : Node_Type) return Boolean is - begin - return Nodet.Table (N).Flag10; - end Get_Flag10; - - procedure Set_Flag10 (N : Node_Type; V : Boolean) is - begin - Nodet.Table (N).Flag10 := V; - end Set_Flag10; - - - function Get_State1 (N : Node_Type) return Bit2_Type is - begin - return Nodet.Table (N).State1; - end Get_State1; - - procedure Set_State1 (N : Node_Type; V : Bit2_Type) is - begin - Nodet.Table (N).State1 := V; - end Set_State1; - - function Get_State2 (N : Node_Type) return Bit2_Type is - begin - return Nodet.Table (N).State2; - end Get_State2; - - procedure Set_State2 (N : Node_Type; V : Bit2_Type) is - begin - Nodet.Table (N).State2 := V; - end Set_State2; - - function Get_State3 (N : Node_Type) return Bit2_Type is - begin - return Nodet.Table (N + 1).State1; - end Get_State3; - - procedure Set_State3 (N : Node_Type; V : Bit2_Type) is - begin - Nodet.Table (N + 1).State1 := V; - end Set_State3; - - function Get_State4 (N : Node_Type) return Bit2_Type is - begin - return Nodet.Table (N + 1).State2; - end Get_State4; - - procedure Set_State4 (N : Node_Type; V : Bit2_Type) is - begin - Nodet.Table (N + 1).State2 := V; - end Set_State4; - - - function Get_Odigit1 (N : Node_Type) return Bit3_Type is - begin - return Nodet.Table (N).Odigit1; - end Get_Odigit1; - - procedure Set_Odigit1 (N : Node_Type; V : Bit3_Type) is - begin - Nodet.Table (N).Odigit1 := V; - end Set_Odigit1; - - function Get_Odigit2 (N : Node_Type) return Bit3_Type is - begin - return Nodet.Table (N + 1).Odigit1; - end Get_Odigit2; - - procedure Set_Odigit2 (N : Node_Type; V : Bit3_Type) is - begin - Nodet.Table (N + 1).Odigit1 := V; - end Set_Odigit2; - - - function Get_Fp64 (N : Node_Type) return Iir_Fp64 is - begin - return Nodet.Table (N).Fp64; - end Get_Fp64; - - procedure Set_Fp64 (N : Node_Type; V : Iir_Fp64) is - begin - Nodet.Table (N).Fp64 := V; - end Set_Fp64; - - - function Get_Int64 (N : Node_Type) return Iir_Int64 is - begin - return Nodet.Table (N).Int64; - end Get_Int64; - - procedure Set_Int64 (N : Node_Type; V : Iir_Int64) is - begin - Nodet.Table (N).Int64 := V; - end Set_Int64; - - procedure Initialize is - begin - Nodet.Free; - Nodet.Init; - end Initialize; -end Nodes; diff --git a/nodes.ads b/nodes.ads deleted file mode 100644 index adf6a5ee8..000000000 --- a/nodes.ads +++ /dev/null @@ -1,335 +0,0 @@ --- Internal node type and operations. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Types; use Types; - -package Nodes is - type Node_Type is new Int32; - for Node_Type'Size use 32; - - Null_Node : constant Node_Type := 0; - Error_Node : constant Node_Type := 1; - - -- A simple type that needs only 2 bits. - type Bit2_Type is range 0 .. 2 ** 2 - 1; - type Bit3_Type is range 0 .. 2 ** 3 - 1; - - type Kind_Type is range 0 .. 255; - - -- Format of a node. - type Format_Type is - ( - Format_Short, - Format_Medium, - Format_Fp, - Format_Int - ); - - -- Future layout: (rem) - -- Format: 0 bits 32 - -- Nkind: 16 bits 16 - -- Flags: 8*1 bits 8 - -- State: 2*2 bits 4 - -- Odigit is to be removed. - - -- Future layout (2):(rem) - -- Format: 2 bits 30 - -- Nkind: 8 bits 22 (vhdl: 216 nodes) - -- Flags: 8*1 bits 14 - -- State: 2*2 bits 10 - -- Lang: 2 bits 8 - -- Odigit: 1*3 bits 5 - - -- Common fields are: - -- Flag1 : Boolean - -- Flag2 : Boolean - -- Flag3 : Boolean - -- Flag4 : Boolean - -- Flag5 : Boolean - -- Flag6 : Boolean - -- Flag7 : Boolean - -- Flag8 : Boolean - -- Flag9 : Boolean - -- Flag10 : Boolean - -- Nkind : Kind_Type - -- State1 : Bit2_Type - -- State2 : Bit2_Type - -- Location : Location_Type - -- Field0 : Iir - -- Field1 : Iir - -- Field2 : Iir - -- Field3 : Iir - - -- Fields of Format_Fp: - -- Fp64 : Iir_Fp64 - - -- Fields of Format_Int: - -- Int64 : Iir_Int64 - - -- Fields of Format_Short: - -- Field4 : Iir - -- Field5 : Iir - - -- Fields of Format_Medium: - -- Odigit1 : Bit3_Type - -- Odigit2 : Bit3_Type (odigit1) - -- State3 : Bit2_Type - -- State4 : Bit2_Type - -- Field4 : Iir - -- Field5 : Iir - -- Field6 : Iir (location) - -- Field7 : Iir (field0) - -- Field8 : Iir (field1) - -- Field9 : Iir (field2) - -- Field10 : Iir (field3) - -- Field11 : Iir (field4) - -- Field12 : Iir (field5) - - function Create_Node (Format : Format_Type) return Node_Type; - procedure Free_Node (N : Node_Type); - function Next_Node (N : Node_Type) return Node_Type; - - function Get_Nkind (N : Node_Type) return Kind_Type; - pragma Inline (Get_Nkind); - procedure Set_Nkind (N : Node_Type; Kind : Kind_Type); - pragma Inline (Set_Nkind); - - function Get_Location (N: Node_Type) return Location_Type; - pragma Inline (Get_Location); - procedure Set_Location (N : Node_Type; Location: Location_Type); - pragma Inline (Set_Location); - - function Get_Field0 (N : Node_Type) return Node_Type; - pragma Inline (Get_Field0); - procedure Set_Field0 (N : Node_Type; V : Node_Type); - pragma Inline (Set_Field0); - - function Get_Field1 (N : Node_Type) return Node_Type; - pragma Inline (Get_Field1); - procedure Set_Field1 (N : Node_Type; V : Node_Type); - pragma Inline (Set_Field1); - - function Get_Field2 (N : Node_Type) return Node_Type; - pragma Inline (Get_Field2); - procedure Set_Field2 (N : Node_Type; V : Node_Type); - pragma Inline (Set_Field2); - - function Get_Field3 (N : Node_Type) return Node_Type; - pragma Inline (Get_Field3); - procedure Set_Field3 (N : Node_Type; V : Node_Type); - pragma Inline (Set_Field3); - - function Get_Field4 (N : Node_Type) return Node_Type; - pragma Inline (Get_Field4); - procedure Set_Field4 (N : Node_Type; V : Node_Type); - pragma Inline (Set_Field4); - - - function Get_Field5 (N : Node_Type) return Node_Type; - pragma Inline (Get_Field5); - procedure Set_Field5 (N : Node_Type; V : Node_Type); - pragma Inline (Set_Field5); - - function Get_Field6 (N: Node_Type) return Node_Type; - pragma Inline (Get_Field6); - procedure Set_Field6 (N: Node_Type; Val: Node_Type); - pragma Inline (Set_Field6); - - function Get_Field7 (N: Node_Type) return Node_Type; - pragma Inline (Get_Field7); - procedure Set_Field7 (N: Node_Type; Val: Node_Type); - pragma Inline (Set_Field7); - - function Get_Field8 (N: Node_Type) return Node_Type; - pragma Inline (Get_Field8); - procedure Set_Field8 (N: Node_Type; Val: Node_Type); - pragma Inline (Set_Field8); - - function Get_Field9 (N: Node_Type) return Node_Type; - pragma Inline (Get_Field9); - procedure Set_Field9 (N: Node_Type; Val: Node_Type); - pragma Inline (Set_Field9); - - function Get_Field10 (N: Node_Type) return Node_Type; - pragma Inline (Get_Field10); - procedure Set_Field10 (N: Node_Type; Val: Node_Type); - pragma Inline (Set_Field10); - - function Get_Field11 (N: Node_Type) return Node_Type; - pragma Inline (Get_Field11); - procedure Set_Field11 (N: Node_Type; Val: Node_Type); - pragma Inline (Set_Field11); - - function Get_Field12 (N: Node_Type) return Node_Type; - pragma Inline (Get_Field12); - procedure Set_Field12 (N: Node_Type; Val: Node_Type); - pragma Inline (Set_Field12); - - - function Get_Flag1 (N : Node_Type) return Boolean; - pragma Inline (Get_Flag1); - procedure Set_Flag1 (N : Node_Type; V : Boolean); - pragma Inline (Set_Flag1); - - function Get_Flag2 (N : Node_Type) return Boolean; - pragma Inline (Get_Flag2); - procedure Set_Flag2 (N : Node_Type; V : Boolean); - pragma Inline (Set_Flag2); - - function Get_Flag3 (N : Node_Type) return Boolean; - pragma Inline (Get_Flag3); - procedure Set_Flag3 (N : Node_Type; V : Boolean); - pragma Inline (Set_Flag3); - - function Get_Flag4 (N : Node_Type) return Boolean; - pragma Inline (Get_Flag4); - procedure Set_Flag4 (N : Node_Type; V : Boolean); - pragma Inline (Set_Flag4); - - function Get_Flag5 (N : Node_Type) return Boolean; - pragma Inline (Get_Flag5); - procedure Set_Flag5 (N : Node_Type; V : Boolean); - pragma Inline (Set_Flag5); - - function Get_Flag6 (N : Node_Type) return Boolean; - pragma Inline (Get_Flag6); - procedure Set_Flag6 (N : Node_Type; V : Boolean); - pragma Inline (Set_Flag6); - - function Get_Flag7 (N : Node_Type) return Boolean; - pragma Inline (Get_Flag7); - procedure Set_Flag7 (N : Node_Type; V : Boolean); - pragma Inline (Set_Flag7); - - function Get_Flag8 (N : Node_Type) return Boolean; - pragma Inline (Get_Flag8); - procedure Set_Flag8 (N : Node_Type; V : Boolean); - pragma Inline (Set_Flag8); - - function Get_Flag9 (N : Node_Type) return Boolean; - pragma Inline (Get_Flag9); - procedure Set_Flag9 (N : Node_Type; V : Boolean); - pragma Inline (Set_Flag9); - - function Get_Flag10 (N : Node_Type) return Boolean; - pragma Inline (Get_Flag10); - procedure Set_Flag10 (N : Node_Type; V : Boolean); - pragma Inline (Set_Flag10); - - - function Get_State1 (N : Node_Type) return Bit2_Type; - pragma Inline (Get_State1); - procedure Set_State1 (N : Node_Type; V : Bit2_Type); - pragma Inline (Set_State1); - - function Get_State2 (N : Node_Type) return Bit2_Type; - pragma Inline (Get_State2); - procedure Set_State2 (N : Node_Type; V : Bit2_Type); - pragma Inline (Set_State2); - - function Get_State3 (N : Node_Type) return Bit2_Type; - pragma Inline (Get_State3); - procedure Set_State3 (N : Node_Type; V : Bit2_Type); - pragma Inline (Set_State3); - - function Get_State4 (N : Node_Type) return Bit2_Type; - pragma Inline (Get_State4); - procedure Set_State4 (N : Node_Type; V : Bit2_Type); - pragma Inline (Set_State4); - - - function Get_Odigit1 (N : Node_Type) return Bit3_Type; - pragma Inline (Get_Odigit1); - procedure Set_Odigit1 (N : Node_Type; V : Bit3_Type); - pragma Inline (Set_Odigit1); - - function Get_Odigit2 (N : Node_Type) return Bit3_Type; - pragma Inline (Get_Odigit2); - procedure Set_Odigit2 (N : Node_Type; V : Bit3_Type); - pragma Inline (Set_Odigit2); - - - function Get_Fp64 (N : Node_Type) return Iir_Fp64; - pragma Inline (Get_Fp64); - procedure Set_Fp64 (N : Node_Type; V : Iir_Fp64); - pragma Inline (Set_Fp64); - - function Get_Int64 (N : Node_Type) return Iir_Int64; - pragma Inline (Get_Int64); - procedure Set_Int64 (N : Node_Type; V : Iir_Int64); - pragma Inline (Set_Int64); - - -- Get the last node allocated. - function Get_Last_Node return Node_Type; - pragma Inline (Get_Last_Node); - - -- Free all and reinit. - procedure Initialize; -private - type Node_Record (Format : Format_Type := Format_Short) is record - Flag1 : Boolean := False; - Flag2 : Boolean := False; - Flag3 : Boolean := False; - Flag4 : Boolean := False; - Flag5 : Boolean := False; - Flag6 : Boolean := False; - - -- Kind field use 8 bits. - -- So, on 32 bits systems, there are 24 bits left. - -- + 8 (8 * 1) - -- + 10 (5 * 2) - -- + 6 (2 * 3) - -- = 24 - - Kind : Kind_Type; - - State1 : Bit2_Type := 0; - State2 : Bit2_Type := 0; - Flag7 : Boolean := False; - Flag8 : Boolean := False; - Flag9 : Boolean := False; - Flag10 : Boolean := False; - - Flag11 : Boolean := False; - Flag12 : Boolean := False; - Odigit1 : Bit3_Type := 0; - Unused_Odigit2 : Bit3_Type := 0; - - -- Location. - Location: Location_Type := Location_Nil; - - Field0 : Node_Type := Null_Node; - Field1: Node_Type := Null_Node; - Field2: Node_Type := Null_Node; - Field3: Node_Type := Null_Node; - - case Format is - when Format_Short - | Format_Medium => - Field4: Node_Type := Null_Node; - Field5: Node_Type := Null_Node; - when Format_Fp => - Fp64 : Iir_Fp64; - when Format_Int => - Int64 : Iir_Int64; - end case; - end record; - - pragma Pack (Node_Record); - for Node_Record'Size use 8*32; - for Node_Record'Alignment use 4; -end Nodes; diff --git a/nodes_gc.adb b/nodes_gc.adb deleted file mode 100644 index 38966f27c..000000000 --- a/nodes_gc.adb +++ /dev/null @@ -1,206 +0,0 @@ --- Node garbage collector (for debugging). --- Copyright (C) 2014 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Ada.Text_IO; -with Types; use Types; -with Nodes; -with Nodes_Meta; -with Iirs; use Iirs; -with Libraries; -with Disp_Tree; -with Std_Package; - -package body Nodes_GC is - - type Marker_Array is array (Iir range <>) of Boolean; - type Marker_Array_Acc is access Marker_Array; - - Markers : Marker_Array_Acc; - - procedure Mark_Iir (N : Iir); - - procedure Mark_Iir_List (N : Iir_List) - is - El : Iir; - begin - case N is - when Null_Iir_List - | Iir_List_All - | Iir_List_Others => - null; - when others => - for I in Natural loop - El := Get_Nth_Element (N, I); - exit when El = Null_Iir; - Mark_Iir (El); - end loop; - end case; - end Mark_Iir_List; - - procedure Mark_PSL_Node (N : PSL_Node) is - begin - null; - end Mark_PSL_Node; - - procedure Mark_PSL_NFA (N : PSL_NFA) is - begin - null; - end Mark_PSL_NFA; - - procedure Report_Already_Marked (N : Iir) - is - use Ada.Text_IO; - begin - Disp_Tree.Disp_Tree (N, True); - return; - end Report_Already_Marked; - - procedure Already_Marked (N : Iir) is - begin - -- An unused node mustn't be referenced. - if Get_Kind (N) = Iir_Kind_Unused then - raise Internal_Error; - end if; - - if not Flag_Disp_Multiref then - return; - end if; - - case Get_Kind (N) is - when Iir_Kind_Interface_Constant_Declaration => - if Get_Identifier (N) = Null_Identifier then - -- Anonymous interfaces are shared by predefined functions. - return; - end if; - when Iir_Kind_Enumeration_Literal => - if Get_Enum_Pos (N) = 0 - or else N = Get_Right_Limit (Get_Range_Constraint - (Get_Type (N))) - then - return; - end if; - when others => - null; - end case; - - Report_Already_Marked (N); - end Already_Marked; - - procedure Mark_Chain (Head : Iir) - is - El : Iir; - begin - El := Head; - while El /= Null_Iir loop - Mark_Iir (El); - El := Get_Chain (El); - end loop; - end Mark_Chain; - - procedure Report_Unreferenced_Node (N : Iir) is - begin - Disp_Tree.Disp_Tree (N, True); - end Report_Unreferenced_Node; - - procedure Mark_Iir (N : Iir) is - begin - if N = Null_Iir then - return; - elsif Markers (N) then - Already_Marked (N); - return; - else - Markers (N) := True; - end if; - - declare - use Nodes_Meta; - Fields : constant Fields_Array := Get_Fields (Get_Kind (N)); - F : Fields_Enum; - begin - for I in Fields'Range loop - F := Fields (I); - case Get_Field_Attribute (F) is - when Attr_Ref - | Attr_Chain_Next => - null; - when Attr_Maybe_Ref => - if not Get_Is_Ref (N) then - Mark_Iir (Get_Iir (N, F)); - end if; - when Attr_Chain => - Mark_Chain (Get_Iir (N, F)); - when Attr_None => - case Get_Field_Type (F) is - when Type_Iir => - Mark_Iir (Get_Iir (N, F)); - when Type_Iir_List => - Mark_Iir_List (Get_Iir_List (N, F)); - when Type_PSL_Node => - Mark_PSL_Node (Get_PSL_Node (N, F)); - when Type_PSL_NFA => - Mark_PSL_NFA (Get_PSL_NFA (N, F)); - when others => - null; - end case; - when Attr_Of_Ref => - raise Internal_Error; - end case; - end loop; - end; - end Mark_Iir; - - procedure Report_Unreferenced - is - use Ada.Text_IO; - use Std_Package; - El : Iir; - Nbr_Unreferenced : Natural; - begin - Markers := new Marker_Array'(Null_Iir .. Iirs.Get_Last_Node => False); - - if Flag_Disp_Multiref then - Put_Line ("** nodes already marked:"); - end if; - - Mark_Chain (Libraries.Get_Libraries_Chain); - Mark_Chain (Libraries.Obsoleted_Design_Units); - Mark_Iir (Convertible_Integer_Type_Declaration); - Mark_Iir (Convertible_Integer_Subtype_Declaration); - Mark_Iir (Convertible_Real_Type_Declaration); - Mark_Iir (Universal_Integer_One); - Mark_Iir (Error_Mark); - - El := Error_Mark; - Nbr_Unreferenced := 0; - while El in Markers'Range loop - if not Markers (El) and then Get_Kind (El) /= Iir_Kind_Unused then - if Nbr_Unreferenced = 0 then - Put_Line ("** unreferenced nodes:"); - end if; - Nbr_Unreferenced := Nbr_Unreferenced + 1; - Report_Unreferenced_Node (El); - end if; - El := Iir (Nodes.Next_Node (Nodes.Node_Type (El))); - end loop; - - if Nbr_Unreferenced /= 0 then - raise Internal_Error; - end if; - end Report_Unreferenced; -end Nodes_GC; diff --git a/nodes_gc.adb.in b/nodes_gc.adb.in deleted file mode 100644 index 7c4303bc5..000000000 --- a/nodes_gc.adb.in +++ /dev/null @@ -1,159 +0,0 @@ --- Node garbage collector (for debugging). --- Copyright (C) 2014 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Ada.Text_IO; -with Types; use Types; -with Nodes; -with Iirs; use Iirs; -with Libraries; -with Disp_Tree; -with Std_Package; - -package body Nodes_GC is - - type Marker_Array is array (Iir range <>) of Boolean; - type Marker_Array_Acc is access Marker_Array; - - Markers : Marker_Array_Acc; - - procedure Mark_Iir (N : Iir); - - procedure Mark_Iir_List (N : Iir_List) - is - El : Iir; - begin - case N is - when Null_Iir_List - | Iir_List_All - | Iir_List_Others => - null; - when others => - for I in Natural loop - El := Get_Nth_Element (N, I); - exit when El = Null_Iir; - Mark_Iir (El); - end loop; - end case; - end Mark_Iir_List; - - procedure Mark_PSL_Node (N : PSL_Node) is - begin - null; - end Mark_PSL_Node; - - procedure Mark_PSL_NFA (N : PSL_NFA) is - begin - null; - end Mark_PSL_NFA; - - procedure Report_Already_Marked (N : Iir) - is - use Ada.Text_IO; - begin - Disp_Tree.Disp_Tree (N, True); - return; - end Report_Already_Marked; - - procedure Already_Marked (N : Iir) is - begin - -- An unused node mustn't be referenced. - if Get_Kind (N) = Iir_Kind_Unused then - raise Internal_Error; - end if; - - if not Flag_Disp_Multiref then - return; - end if; - - case Get_Kind (N) is - when Iir_Kind_Constant_Interface_Declaration => - if Get_Identifier (N) = Null_Identifier then - -- Anonymous interfaces are shared by predefined functions. - return; - end if; - when Iir_Kind_Enumeration_Literal => - if Get_Enum_Pos (N) = 0 - or else N = Get_Right_Limit (Get_Range_Constraint - (Get_Type (N))) - then - return; - end if; - when others => - null; - end case; - - Report_Already_Marked (N); - end Already_Marked; - - procedure Mark_Chain (Head : Iir) - is - El : Iir; - begin - El := Head; - while El /= Null_Iir loop - Mark_Iir (El); - El := Get_Chain (El); - end loop; - end Mark_Chain; - - procedure Report_Unreferenced_Node (N : Iir) is - begin - Disp_Tree.Disp_Tree (N, True); - end Report_Unreferenced_Node; - - -- Subprograms - - procedure Report_Unreferenced - is - use Ada.Text_IO; - use Std_Package; - El : Iir; - Nbr_Unreferenced : Natural; - begin - Markers := new Marker_Array'(Null_Iir .. Iirs.Get_Last_Node => False); - - if Flag_Disp_Multiref then - Put_Line ("** nodes already marked:"); - end if; - - Mark_Chain (Libraries.Get_Libraries_Chain); - Mark_Chain (Libraries.Obsoleted_Design_Units); - Mark_Iir (Convertible_Integer_Type_Declaration); - Mark_Iir (Convertible_Integer_Subtype_Declaration); - Mark_Iir (Convertible_Real_Type_Declaration); - Mark_Iir (Universal_Integer_One); - Mark_Iir (Error_Mark); - - El := Error_Mark; - Nbr_Unreferenced := 0; - while El in Markers'Range loop - if not Markers (El) and then Get_Kind (El) /= Iir_Kind_Unused then - if Nbr_Unreferenced = 0 then - Put_Line ("** unreferenced nodes:"); - end if; - Nbr_Unreferenced := Nbr_Unreferenced + 1; - Report_Unreferenced_Node (El); - end if; - El := Iir (Nodes.Next_Node (Nodes.Node_Type (El))); - end loop; - - if Nbr_Unreferenced /= 0 then - raise Internal_Error; - end if; - end Report_Unreferenced; -end Nodes_GC; diff --git a/nodes_gc.ads b/nodes_gc.ads deleted file mode 100644 index ef8e647c3..000000000 --- a/nodes_gc.ads +++ /dev/null @@ -1,24 +0,0 @@ --- Node garbage collector (for debugging). --- Copyright (C) 2014 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -package Nodes_GC is - Flag_Disp_Multiref : Boolean := False; - - procedure Report_Unreferenced; - -- Display nodes that aren't referenced. -end Nodes_GC; diff --git a/nodes_meta.adb b/nodes_meta.adb deleted file mode 100644 index 3e038f549..000000000 --- a/nodes_meta.adb +++ /dev/null @@ -1,9409 +0,0 @@ --- Meta description of nodes. --- Copyright (C) 2014 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -package body Nodes_Meta is - Fields_Type : constant array (Fields_Enum) of Types_Enum := - ( - Field_First_Design_Unit => Type_Iir, - Field_Last_Design_Unit => Type_Iir, - Field_Library_Declaration => Type_Iir, - Field_File_Time_Stamp => Type_Time_Stamp_Id, - Field_Analysis_Time_Stamp => Type_Time_Stamp_Id, - Field_Library => Type_Iir, - Field_File_Dependence_List => Type_Iir_List, - Field_Design_File_Filename => Type_Name_Id, - Field_Design_File_Directory => Type_Name_Id, - Field_Design_File => Type_Iir, - Field_Design_File_Chain => Type_Iir, - Field_Library_Directory => Type_Name_Id, - Field_Date => Type_Date_Type, - Field_Context_Items => Type_Iir, - Field_Dependence_List => Type_Iir_List, - Field_Analysis_Checks_List => Type_Iir_List, - Field_Date_State => Type_Date_State_Type, - Field_Guarded_Target_State => Type_Tri_State_Type, - Field_Library_Unit => Type_Iir, - Field_Hash_Chain => Type_Iir, - Field_Design_Unit_Source_Pos => Type_Source_Ptr, - Field_Design_Unit_Source_Line => Type_Int32, - Field_Design_Unit_Source_Col => Type_Int32, - Field_Value => Type_Iir_Int64, - Field_Enum_Pos => Type_Iir_Int32, - Field_Physical_Literal => Type_Iir, - Field_Physical_Unit_Value => Type_Iir, - Field_Fp_Value => Type_Iir_Fp64, - Field_Enumeration_Decl => Type_Iir, - Field_Simple_Aggregate_List => Type_Iir_List, - Field_Bit_String_Base => Type_Base_Type, - Field_Bit_String_0 => Type_Iir, - Field_Bit_String_1 => Type_Iir, - Field_Literal_Origin => Type_Iir, - Field_Range_Origin => Type_Iir, - Field_Literal_Subtype => Type_Iir, - Field_Entity_Class => Type_Token_Type, - Field_Entity_Name_List => Type_Iir_List, - Field_Attribute_Designator => Type_Iir, - Field_Attribute_Specification_Chain => Type_Iir, - Field_Attribute_Specification => Type_Iir, - Field_Signal_List => Type_Iir_List, - Field_Designated_Entity => Type_Iir, - Field_Formal => Type_Iir, - Field_Actual => Type_Iir, - Field_In_Conversion => Type_Iir, - Field_Out_Conversion => Type_Iir, - Field_Whole_Association_Flag => Type_Boolean, - Field_Collapse_Signal_Flag => Type_Boolean, - Field_Artificial_Flag => Type_Boolean, - Field_Open_Flag => Type_Boolean, - Field_After_Drivers_Flag => Type_Boolean, - Field_We_Value => Type_Iir, - Field_Time => Type_Iir, - Field_Associated_Expr => Type_Iir, - Field_Associated_Chain => Type_Iir, - Field_Choice_Name => Type_Iir, - Field_Choice_Expression => Type_Iir, - Field_Choice_Range => Type_Iir, - Field_Same_Alternative_Flag => Type_Boolean, - Field_Architecture => Type_Iir, - Field_Block_Specification => Type_Iir, - Field_Prev_Block_Configuration => Type_Iir, - Field_Configuration_Item_Chain => Type_Iir, - Field_Attribute_Value_Chain => Type_Iir, - Field_Spec_Chain => Type_Iir, - Field_Attribute_Value_Spec_Chain => Type_Iir, - Field_Entity_Name => Type_Iir, - Field_Package => Type_Iir, - Field_Package_Body => Type_Iir, - Field_Need_Body => Type_Boolean, - Field_Block_Configuration => Type_Iir, - Field_Concurrent_Statement_Chain => Type_Iir, - Field_Chain => Type_Iir, - Field_Port_Chain => Type_Iir, - Field_Generic_Chain => Type_Iir, - Field_Type => Type_Iir, - Field_Subtype_Indication => Type_Iir, - Field_Discrete_Range => Type_Iir, - Field_Type_Definition => Type_Iir, - Field_Subtype_Definition => Type_Iir, - Field_Nature => Type_Iir, - Field_Mode => Type_Iir_Mode, - Field_Signal_Kind => Type_Iir_Signal_Kind, - Field_Base_Name => Type_Iir, - Field_Interface_Declaration_Chain => Type_Iir, - Field_Subprogram_Specification => Type_Iir, - Field_Sequential_Statement_Chain => Type_Iir, - Field_Subprogram_Body => Type_Iir, - Field_Overload_Number => Type_Iir_Int32, - Field_Subprogram_Depth => Type_Iir_Int32, - Field_Subprogram_Hash => Type_Iir_Int32, - Field_Impure_Depth => Type_Iir_Int32, - Field_Return_Type => Type_Iir, - Field_Implicit_Definition => Type_Iir_Predefined_Functions, - Field_Type_Reference => Type_Iir, - Field_Default_Value => Type_Iir, - Field_Deferred_Declaration => Type_Iir, - Field_Deferred_Declaration_Flag => Type_Boolean, - Field_Shared_Flag => Type_Boolean, - Field_Design_Unit => Type_Iir, - Field_Block_Statement => Type_Iir, - Field_Signal_Driver => Type_Iir, - Field_Declaration_Chain => Type_Iir, - Field_File_Logical_Name => Type_Iir, - Field_File_Open_Kind => Type_Iir, - Field_Element_Position => Type_Iir_Index32, - Field_Element_Declaration => Type_Iir, - Field_Selected_Element => Type_Iir, - Field_Use_Clause_Chain => Type_Iir, - Field_Selected_Name => Type_Iir, - Field_Type_Declarator => Type_Iir, - Field_Enumeration_Literal_List => Type_Iir_List, - Field_Entity_Class_Entry_Chain => Type_Iir, - Field_Group_Constituent_List => Type_Iir_List, - Field_Unit_Chain => Type_Iir, - Field_Primary_Unit => Type_Iir, - Field_Identifier => Type_Name_Id, - Field_Label => Type_Name_Id, - Field_Visible_Flag => Type_Boolean, - Field_Range_Constraint => Type_Iir, - Field_Direction => Type_Iir_Direction, - Field_Left_Limit => Type_Iir, - Field_Right_Limit => Type_Iir, - Field_Base_Type => Type_Iir, - Field_Resolution_Indication => Type_Iir, - Field_Record_Element_Resolution_Chain => Type_Iir, - Field_Tolerance => Type_Iir, - Field_Plus_Terminal => Type_Iir, - Field_Minus_Terminal => Type_Iir, - Field_Simultaneous_Left => Type_Iir, - Field_Simultaneous_Right => Type_Iir, - Field_Text_File_Flag => Type_Boolean, - Field_Only_Characters_Flag => Type_Boolean, - Field_Type_Staticness => Type_Iir_Staticness, - Field_Constraint_State => Type_Iir_Constraint, - Field_Index_Subtype_List => Type_Iir_List, - Field_Index_Subtype_Definition_List => Type_Iir_List, - Field_Element_Subtype_Indication => Type_Iir, - Field_Element_Subtype => Type_Iir, - Field_Index_Constraint_List => Type_Iir_List, - Field_Array_Element_Constraint => Type_Iir, - Field_Elements_Declaration_List => Type_Iir_List, - Field_Designated_Type => Type_Iir, - Field_Designated_Subtype_Indication => Type_Iir, - Field_Index_List => Type_Iir_List, - Field_Reference => Type_Iir, - Field_Nature_Declarator => Type_Iir, - Field_Across_Type => Type_Iir, - Field_Through_Type => Type_Iir, - Field_Target => Type_Iir, - Field_Waveform_Chain => Type_Iir, - Field_Guard => Type_Iir, - Field_Delay_Mechanism => Type_Iir_Delay_Mechanism, - Field_Reject_Time_Expression => Type_Iir, - Field_Sensitivity_List => Type_Iir_List, - Field_Process_Origin => Type_Iir, - Field_Condition_Clause => Type_Iir, - Field_Timeout_Clause => Type_Iir, - Field_Postponed_Flag => Type_Boolean, - Field_Callees_List => Type_Iir_List, - Field_Passive_Flag => Type_Boolean, - Field_Resolution_Function_Flag => Type_Boolean, - Field_Wait_State => Type_Tri_State_Type, - Field_All_Sensitized_State => Type_Iir_All_Sensitized, - Field_Seen_Flag => Type_Boolean, - Field_Pure_Flag => Type_Boolean, - Field_Foreign_Flag => Type_Boolean, - Field_Resolved_Flag => Type_Boolean, - Field_Signal_Type_Flag => Type_Boolean, - Field_Has_Signal_Flag => Type_Boolean, - Field_Purity_State => Type_Iir_Pure_State, - Field_Elab_Flag => Type_Boolean, - Field_Index_Constraint_Flag => Type_Boolean, - Field_Assertion_Condition => Type_Iir, - Field_Report_Expression => Type_Iir, - Field_Severity_Expression => Type_Iir, - Field_Instantiated_Unit => Type_Iir, - Field_Generic_Map_Aspect_Chain => Type_Iir, - Field_Port_Map_Aspect_Chain => Type_Iir, - Field_Configuration_Name => Type_Iir, - Field_Component_Configuration => Type_Iir, - Field_Configuration_Specification => Type_Iir, - Field_Default_Binding_Indication => Type_Iir, - Field_Default_Configuration_Declaration => Type_Iir, - Field_Expression => Type_Iir, - Field_Allocator_Designated_Type => Type_Iir, - Field_Selected_Waveform_Chain => Type_Iir, - Field_Conditional_Waveform_Chain => Type_Iir, - Field_Guard_Expression => Type_Iir, - Field_Guard_Decl => Type_Iir, - Field_Guard_Sensitivity_List => Type_Iir_List, - Field_Block_Block_Configuration => Type_Iir, - Field_Package_Header => Type_Iir, - Field_Block_Header => Type_Iir, - Field_Uninstantiated_Package_Name => Type_Iir, - Field_Generate_Block_Configuration => Type_Iir, - Field_Generation_Scheme => Type_Iir, - Field_Condition => Type_Iir, - Field_Else_Clause => Type_Iir, - Field_Parameter_Specification => Type_Iir, - Field_Parent => Type_Iir, - Field_Loop_Label => Type_Iir, - Field_Component_Name => Type_Iir, - Field_Instantiation_List => Type_Iir_List, - Field_Entity_Aspect => Type_Iir, - Field_Default_Entity_Aspect => Type_Iir, - Field_Default_Generic_Map_Aspect_Chain => Type_Iir, - Field_Default_Port_Map_Aspect_Chain => Type_Iir, - Field_Binding_Indication => Type_Iir, - Field_Named_Entity => Type_Iir, - Field_Alias_Declaration => Type_Iir, - Field_Expr_Staticness => Type_Iir_Staticness, - Field_Error_Origin => Type_Iir, - Field_Operand => Type_Iir, - Field_Left => Type_Iir, - Field_Right => Type_Iir, - Field_Unit_Name => Type_Iir, - Field_Name => Type_Iir, - Field_Group_Template_Name => Type_Iir, - Field_Name_Staticness => Type_Iir_Staticness, - Field_Prefix => Type_Iir, - Field_Signature_Prefix => Type_Iir, - Field_Slice_Subtype => Type_Iir, - Field_Suffix => Type_Iir, - Field_Index_Subtype => Type_Iir, - Field_Parameter => Type_Iir, - Field_Actual_Type => Type_Iir, - Field_Associated_Interface => Type_Iir, - Field_Association_Chain => Type_Iir, - Field_Individual_Association_Chain => Type_Iir, - Field_Aggregate_Info => Type_Iir, - Field_Sub_Aggregate_Info => Type_Iir, - Field_Aggr_Dynamic_Flag => Type_Boolean, - Field_Aggr_Min_Length => Type_Iir_Int32, - Field_Aggr_Low_Limit => Type_Iir, - Field_Aggr_High_Limit => Type_Iir, - Field_Aggr_Others_Flag => Type_Boolean, - Field_Aggr_Named_Flag => Type_Boolean, - Field_Value_Staticness => Type_Iir_Staticness, - Field_Association_Choices_Chain => Type_Iir, - Field_Case_Statement_Alternative_Chain => Type_Iir, - Field_Choice_Staticness => Type_Iir_Staticness, - Field_Procedure_Call => Type_Iir, - Field_Implementation => Type_Iir, - Field_Parameter_Association_Chain => Type_Iir, - Field_Method_Object => Type_Iir, - Field_Subtype_Type_Mark => Type_Iir, - Field_Type_Conversion_Subtype => Type_Iir, - Field_Type_Mark => Type_Iir, - Field_File_Type_Mark => Type_Iir, - Field_Return_Type_Mark => Type_Iir, - Field_Lexical_Layout => Type_Iir_Lexical_Layout_Type, - Field_Incomplete_Type_List => Type_Iir_List, - Field_Has_Disconnect_Flag => Type_Boolean, - Field_Has_Active_Flag => Type_Boolean, - Field_Is_Within_Flag => Type_Boolean, - Field_Type_Marks_List => Type_Iir_List, - Field_Implicit_Alias_Flag => Type_Boolean, - Field_Alias_Signature => Type_Iir, - Field_Attribute_Signature => Type_Iir, - Field_Overload_List => Type_Iir_List, - Field_Simple_Name_Identifier => Type_Name_Id, - Field_Simple_Name_Subtype => Type_Iir, - Field_Protected_Type_Body => Type_Iir, - Field_Protected_Type_Declaration => Type_Iir, - Field_End_Location => Type_Location_Type, - Field_String_Id => Type_String_Id, - Field_String_Length => Type_Int32, - Field_Use_Flag => Type_Boolean, - Field_End_Has_Reserved_Id => Type_Boolean, - Field_End_Has_Identifier => Type_Boolean, - Field_End_Has_Postponed => Type_Boolean, - Field_Has_Begin => Type_Boolean, - Field_Has_Is => Type_Boolean, - Field_Has_Pure => Type_Boolean, - Field_Has_Body => Type_Boolean, - Field_Has_Identifier_List => Type_Boolean, - Field_Has_Mode => Type_Boolean, - Field_Is_Ref => Type_Boolean, - Field_Psl_Property => Type_PSL_Node, - Field_Psl_Declaration => Type_PSL_Node, - Field_Psl_Expression => Type_PSL_Node, - Field_Psl_Boolean => Type_PSL_Node, - Field_PSL_Clock => Type_PSL_Node, - Field_PSL_NFA => Type_PSL_NFA - ); - - function Get_Field_Type (F : Fields_Enum) return Types_Enum is - begin - return Fields_Type (F); - end Get_Field_Type; - - function Get_Field_Image (F : Fields_Enum) return String is - begin - case F is - when Field_First_Design_Unit => - return "first_design_unit"; - when Field_Last_Design_Unit => - return "last_design_unit"; - when Field_Library_Declaration => - return "library_declaration"; - when Field_File_Time_Stamp => - return "file_time_stamp"; - when Field_Analysis_Time_Stamp => - return "analysis_time_stamp"; - when Field_Library => - return "library"; - when Field_File_Dependence_List => - return "file_dependence_list"; - when Field_Design_File_Filename => - return "design_file_filename"; - when Field_Design_File_Directory => - return "design_file_directory"; - when Field_Design_File => - return "design_file"; - when Field_Design_File_Chain => - return "design_file_chain"; - when Field_Library_Directory => - return "library_directory"; - when Field_Date => - return "date"; - when Field_Context_Items => - return "context_items"; - when Field_Dependence_List => - return "dependence_list"; - when Field_Analysis_Checks_List => - return "analysis_checks_list"; - when Field_Date_State => - return "date_state"; - when Field_Guarded_Target_State => - return "guarded_target_state"; - when Field_Library_Unit => - return "library_unit"; - when Field_Hash_Chain => - return "hash_chain"; - when Field_Design_Unit_Source_Pos => - return "design_unit_source_pos"; - when Field_Design_Unit_Source_Line => - return "design_unit_source_line"; - when Field_Design_Unit_Source_Col => - return "design_unit_source_col"; - when Field_Value => - return "value"; - when Field_Enum_Pos => - return "enum_pos"; - when Field_Physical_Literal => - return "physical_literal"; - when Field_Physical_Unit_Value => - return "physical_unit_value"; - when Field_Fp_Value => - return "fp_value"; - when Field_Enumeration_Decl => - return "enumeration_decl"; - when Field_Simple_Aggregate_List => - return "simple_aggregate_list"; - when Field_Bit_String_Base => - return "bit_string_base"; - when Field_Bit_String_0 => - return "bit_string_0"; - when Field_Bit_String_1 => - return "bit_string_1"; - when Field_Literal_Origin => - return "literal_origin"; - when Field_Range_Origin => - return "range_origin"; - when Field_Literal_Subtype => - return "literal_subtype"; - when Field_Entity_Class => - return "entity_class"; - when Field_Entity_Name_List => - return "entity_name_list"; - when Field_Attribute_Designator => - return "attribute_designator"; - when Field_Attribute_Specification_Chain => - return "attribute_specification_chain"; - when Field_Attribute_Specification => - return "attribute_specification"; - when Field_Signal_List => - return "signal_list"; - when Field_Designated_Entity => - return "designated_entity"; - when Field_Formal => - return "formal"; - when Field_Actual => - return "actual"; - when Field_In_Conversion => - return "in_conversion"; - when Field_Out_Conversion => - return "out_conversion"; - when Field_Whole_Association_Flag => - return "whole_association_flag"; - when Field_Collapse_Signal_Flag => - return "collapse_signal_flag"; - when Field_Artificial_Flag => - return "artificial_flag"; - when Field_Open_Flag => - return "open_flag"; - when Field_After_Drivers_Flag => - return "after_drivers_flag"; - when Field_We_Value => - return "we_value"; - when Field_Time => - return "time"; - when Field_Associated_Expr => - return "associated_expr"; - when Field_Associated_Chain => - return "associated_chain"; - when Field_Choice_Name => - return "choice_name"; - when Field_Choice_Expression => - return "choice_expression"; - when Field_Choice_Range => - return "choice_range"; - when Field_Same_Alternative_Flag => - return "same_alternative_flag"; - when Field_Architecture => - return "architecture"; - when Field_Block_Specification => - return "block_specification"; - when Field_Prev_Block_Configuration => - return "prev_block_configuration"; - when Field_Configuration_Item_Chain => - return "configuration_item_chain"; - when Field_Attribute_Value_Chain => - return "attribute_value_chain"; - when Field_Spec_Chain => - return "spec_chain"; - when Field_Attribute_Value_Spec_Chain => - return "attribute_value_spec_chain"; - when Field_Entity_Name => - return "entity_name"; - when Field_Package => - return "package"; - when Field_Package_Body => - return "package_body"; - when Field_Need_Body => - return "need_body"; - when Field_Block_Configuration => - return "block_configuration"; - when Field_Concurrent_Statement_Chain => - return "concurrent_statement_chain"; - when Field_Chain => - return "chain"; - when Field_Port_Chain => - return "port_chain"; - when Field_Generic_Chain => - return "generic_chain"; - when Field_Type => - return "type"; - when Field_Subtype_Indication => - return "subtype_indication"; - when Field_Discrete_Range => - return "discrete_range"; - when Field_Type_Definition => - return "type_definition"; - when Field_Subtype_Definition => - return "subtype_definition"; - when Field_Nature => - return "nature"; - when Field_Mode => - return "mode"; - when Field_Signal_Kind => - return "signal_kind"; - when Field_Base_Name => - return "base_name"; - when Field_Interface_Declaration_Chain => - return "interface_declaration_chain"; - when Field_Subprogram_Specification => - return "subprogram_specification"; - when Field_Sequential_Statement_Chain => - return "sequential_statement_chain"; - when Field_Subprogram_Body => - return "subprogram_body"; - when Field_Overload_Number => - return "overload_number"; - when Field_Subprogram_Depth => - return "subprogram_depth"; - when Field_Subprogram_Hash => - return "subprogram_hash"; - when Field_Impure_Depth => - return "impure_depth"; - when Field_Return_Type => - return "return_type"; - when Field_Implicit_Definition => - return "implicit_definition"; - when Field_Type_Reference => - return "type_reference"; - when Field_Default_Value => - return "default_value"; - when Field_Deferred_Declaration => - return "deferred_declaration"; - when Field_Deferred_Declaration_Flag => - return "deferred_declaration_flag"; - when Field_Shared_Flag => - return "shared_flag"; - when Field_Design_Unit => - return "design_unit"; - when Field_Block_Statement => - return "block_statement"; - when Field_Signal_Driver => - return "signal_driver"; - when Field_Declaration_Chain => - return "declaration_chain"; - when Field_File_Logical_Name => - return "file_logical_name"; - when Field_File_Open_Kind => - return "file_open_kind"; - when Field_Element_Position => - return "element_position"; - when Field_Element_Declaration => - return "element_declaration"; - when Field_Selected_Element => - return "selected_element"; - when Field_Use_Clause_Chain => - return "use_clause_chain"; - when Field_Selected_Name => - return "selected_name"; - when Field_Type_Declarator => - return "type_declarator"; - when Field_Enumeration_Literal_List => - return "enumeration_literal_list"; - when Field_Entity_Class_Entry_Chain => - return "entity_class_entry_chain"; - when Field_Group_Constituent_List => - return "group_constituent_list"; - when Field_Unit_Chain => - return "unit_chain"; - when Field_Primary_Unit => - return "primary_unit"; - when Field_Identifier => - return "identifier"; - when Field_Label => - return "label"; - when Field_Visible_Flag => - return "visible_flag"; - when Field_Range_Constraint => - return "range_constraint"; - when Field_Direction => - return "direction"; - when Field_Left_Limit => - return "left_limit"; - when Field_Right_Limit => - return "right_limit"; - when Field_Base_Type => - return "base_type"; - when Field_Resolution_Indication => - return "resolution_indication"; - when Field_Record_Element_Resolution_Chain => - return "record_element_resolution_chain"; - when Field_Tolerance => - return "tolerance"; - when Field_Plus_Terminal => - return "plus_terminal"; - when Field_Minus_Terminal => - return "minus_terminal"; - when Field_Simultaneous_Left => - return "simultaneous_left"; - when Field_Simultaneous_Right => - return "simultaneous_right"; - when Field_Text_File_Flag => - return "text_file_flag"; - when Field_Only_Characters_Flag => - return "only_characters_flag"; - when Field_Type_Staticness => - return "type_staticness"; - when Field_Constraint_State => - return "constraint_state"; - when Field_Index_Subtype_List => - return "index_subtype_list"; - when Field_Index_Subtype_Definition_List => - return "index_subtype_definition_list"; - when Field_Element_Subtype_Indication => - return "element_subtype_indication"; - when Field_Element_Subtype => - return "element_subtype"; - when Field_Index_Constraint_List => - return "index_constraint_list"; - when Field_Array_Element_Constraint => - return "array_element_constraint"; - when Field_Elements_Declaration_List => - return "elements_declaration_list"; - when Field_Designated_Type => - return "designated_type"; - when Field_Designated_Subtype_Indication => - return "designated_subtype_indication"; - when Field_Index_List => - return "index_list"; - when Field_Reference => - return "reference"; - when Field_Nature_Declarator => - return "nature_declarator"; - when Field_Across_Type => - return "across_type"; - when Field_Through_Type => - return "through_type"; - when Field_Target => - return "target"; - when Field_Waveform_Chain => - return "waveform_chain"; - when Field_Guard => - return "guard"; - when Field_Delay_Mechanism => - return "delay_mechanism"; - when Field_Reject_Time_Expression => - return "reject_time_expression"; - when Field_Sensitivity_List => - return "sensitivity_list"; - when Field_Process_Origin => - return "process_origin"; - when Field_Condition_Clause => - return "condition_clause"; - when Field_Timeout_Clause => - return "timeout_clause"; - when Field_Postponed_Flag => - return "postponed_flag"; - when Field_Callees_List => - return "callees_list"; - when Field_Passive_Flag => - return "passive_flag"; - when Field_Resolution_Function_Flag => - return "resolution_function_flag"; - when Field_Wait_State => - return "wait_state"; - when Field_All_Sensitized_State => - return "all_sensitized_state"; - when Field_Seen_Flag => - return "seen_flag"; - when Field_Pure_Flag => - return "pure_flag"; - when Field_Foreign_Flag => - return "foreign_flag"; - when Field_Resolved_Flag => - return "resolved_flag"; - when Field_Signal_Type_Flag => - return "signal_type_flag"; - when Field_Has_Signal_Flag => - return "has_signal_flag"; - when Field_Purity_State => - return "purity_state"; - when Field_Elab_Flag => - return "elab_flag"; - when Field_Index_Constraint_Flag => - return "index_constraint_flag"; - when Field_Assertion_Condition => - return "assertion_condition"; - when Field_Report_Expression => - return "report_expression"; - when Field_Severity_Expression => - return "severity_expression"; - when Field_Instantiated_Unit => - return "instantiated_unit"; - when Field_Generic_Map_Aspect_Chain => - return "generic_map_aspect_chain"; - when Field_Port_Map_Aspect_Chain => - return "port_map_aspect_chain"; - when Field_Configuration_Name => - return "configuration_name"; - when Field_Component_Configuration => - return "component_configuration"; - when Field_Configuration_Specification => - return "configuration_specification"; - when Field_Default_Binding_Indication => - return "default_binding_indication"; - when Field_Default_Configuration_Declaration => - return "default_configuration_declaration"; - when Field_Expression => - return "expression"; - when Field_Allocator_Designated_Type => - return "allocator_designated_type"; - when Field_Selected_Waveform_Chain => - return "selected_waveform_chain"; - when Field_Conditional_Waveform_Chain => - return "conditional_waveform_chain"; - when Field_Guard_Expression => - return "guard_expression"; - when Field_Guard_Decl => - return "guard_decl"; - when Field_Guard_Sensitivity_List => - return "guard_sensitivity_list"; - when Field_Block_Block_Configuration => - return "block_block_configuration"; - when Field_Package_Header => - return "package_header"; - when Field_Block_Header => - return "block_header"; - when Field_Uninstantiated_Package_Name => - return "uninstantiated_package_name"; - when Field_Generate_Block_Configuration => - return "generate_block_configuration"; - when Field_Generation_Scheme => - return "generation_scheme"; - when Field_Condition => - return "condition"; - when Field_Else_Clause => - return "else_clause"; - when Field_Parameter_Specification => - return "parameter_specification"; - when Field_Parent => - return "parent"; - when Field_Loop_Label => - return "loop_label"; - when Field_Component_Name => - return "component_name"; - when Field_Instantiation_List => - return "instantiation_list"; - when Field_Entity_Aspect => - return "entity_aspect"; - when Field_Default_Entity_Aspect => - return "default_entity_aspect"; - when Field_Default_Generic_Map_Aspect_Chain => - return "default_generic_map_aspect_chain"; - when Field_Default_Port_Map_Aspect_Chain => - return "default_port_map_aspect_chain"; - when Field_Binding_Indication => - return "binding_indication"; - when Field_Named_Entity => - return "named_entity"; - when Field_Alias_Declaration => - return "alias_declaration"; - when Field_Expr_Staticness => - return "expr_staticness"; - when Field_Error_Origin => - return "error_origin"; - when Field_Operand => - return "operand"; - when Field_Left => - return "left"; - when Field_Right => - return "right"; - when Field_Unit_Name => - return "unit_name"; - when Field_Name => - return "name"; - when Field_Group_Template_Name => - return "group_template_name"; - when Field_Name_Staticness => - return "name_staticness"; - when Field_Prefix => - return "prefix"; - when Field_Signature_Prefix => - return "signature_prefix"; - when Field_Slice_Subtype => - return "slice_subtype"; - when Field_Suffix => - return "suffix"; - when Field_Index_Subtype => - return "index_subtype"; - when Field_Parameter => - return "parameter"; - when Field_Actual_Type => - return "actual_type"; - when Field_Associated_Interface => - return "associated_interface"; - when Field_Association_Chain => - return "association_chain"; - when Field_Individual_Association_Chain => - return "individual_association_chain"; - when Field_Aggregate_Info => - return "aggregate_info"; - when Field_Sub_Aggregate_Info => - return "sub_aggregate_info"; - when Field_Aggr_Dynamic_Flag => - return "aggr_dynamic_flag"; - when Field_Aggr_Min_Length => - return "aggr_min_length"; - when Field_Aggr_Low_Limit => - return "aggr_low_limit"; - when Field_Aggr_High_Limit => - return "aggr_high_limit"; - when Field_Aggr_Others_Flag => - return "aggr_others_flag"; - when Field_Aggr_Named_Flag => - return "aggr_named_flag"; - when Field_Value_Staticness => - return "value_staticness"; - when Field_Association_Choices_Chain => - return "association_choices_chain"; - when Field_Case_Statement_Alternative_Chain => - return "case_statement_alternative_chain"; - when Field_Choice_Staticness => - return "choice_staticness"; - when Field_Procedure_Call => - return "procedure_call"; - when Field_Implementation => - return "implementation"; - when Field_Parameter_Association_Chain => - return "parameter_association_chain"; - when Field_Method_Object => - return "method_object"; - when Field_Subtype_Type_Mark => - return "subtype_type_mark"; - when Field_Type_Conversion_Subtype => - return "type_conversion_subtype"; - when Field_Type_Mark => - return "type_mark"; - when Field_File_Type_Mark => - return "file_type_mark"; - when Field_Return_Type_Mark => - return "return_type_mark"; - when Field_Lexical_Layout => - return "lexical_layout"; - when Field_Incomplete_Type_List => - return "incomplete_type_list"; - when Field_Has_Disconnect_Flag => - return "has_disconnect_flag"; - when Field_Has_Active_Flag => - return "has_active_flag"; - when Field_Is_Within_Flag => - return "is_within_flag"; - when Field_Type_Marks_List => - return "type_marks_list"; - when Field_Implicit_Alias_Flag => - return "implicit_alias_flag"; - when Field_Alias_Signature => - return "alias_signature"; - when Field_Attribute_Signature => - return "attribute_signature"; - when Field_Overload_List => - return "overload_list"; - when Field_Simple_Name_Identifier => - return "simple_name_identifier"; - when Field_Simple_Name_Subtype => - return "simple_name_subtype"; - when Field_Protected_Type_Body => - return "protected_type_body"; - when Field_Protected_Type_Declaration => - return "protected_type_declaration"; - when Field_End_Location => - return "end_location"; - when Field_String_Id => - return "string_id"; - when Field_String_Length => - return "string_length"; - when Field_Use_Flag => - return "use_flag"; - when Field_End_Has_Reserved_Id => - return "end_has_reserved_id"; - when Field_End_Has_Identifier => - return "end_has_identifier"; - when Field_End_Has_Postponed => - return "end_has_postponed"; - when Field_Has_Begin => - return "has_begin"; - when Field_Has_Is => - return "has_is"; - when Field_Has_Pure => - return "has_pure"; - when Field_Has_Body => - return "has_body"; - when Field_Has_Identifier_List => - return "has_identifier_list"; - when Field_Has_Mode => - return "has_mode"; - when Field_Is_Ref => - return "is_ref"; - when Field_Psl_Property => - return "psl_property"; - when Field_Psl_Declaration => - return "psl_declaration"; - when Field_Psl_Expression => - return "psl_expression"; - when Field_Psl_Boolean => - return "psl_boolean"; - when Field_PSL_Clock => - return "psl_clock"; - when Field_PSL_NFA => - return "psl_nfa"; - end case; - end Get_Field_Image; - - function Get_Iir_Image (K : Iir_Kind) return String is - begin - case K is - when Iir_Kind_Unused => - return "unused"; - when Iir_Kind_Error => - return "error"; - when Iir_Kind_Design_File => - return "design_file"; - when Iir_Kind_Design_Unit => - return "design_unit"; - when Iir_Kind_Library_Clause => - return "library_clause"; - when Iir_Kind_Use_Clause => - return "use_clause"; - when Iir_Kind_Integer_Literal => - return "integer_literal"; - when Iir_Kind_Floating_Point_Literal => - return "floating_point_literal"; - when Iir_Kind_Null_Literal => - return "null_literal"; - when Iir_Kind_String_Literal => - return "string_literal"; - when Iir_Kind_Physical_Int_Literal => - return "physical_int_literal"; - when Iir_Kind_Physical_Fp_Literal => - return "physical_fp_literal"; - when Iir_Kind_Bit_String_Literal => - return "bit_string_literal"; - when Iir_Kind_Simple_Aggregate => - return "simple_aggregate"; - when Iir_Kind_Overflow_Literal => - return "overflow_literal"; - when Iir_Kind_Waveform_Element => - return "waveform_element"; - when Iir_Kind_Conditional_Waveform => - return "conditional_waveform"; - when Iir_Kind_Association_Element_By_Expression => - return "association_element_by_expression"; - when Iir_Kind_Association_Element_By_Individual => - return "association_element_by_individual"; - when Iir_Kind_Association_Element_Open => - return "association_element_open"; - when Iir_Kind_Association_Element_Package => - return "association_element_package"; - when Iir_Kind_Choice_By_Others => - return "choice_by_others"; - when Iir_Kind_Choice_By_Expression => - return "choice_by_expression"; - when Iir_Kind_Choice_By_Range => - return "choice_by_range"; - when Iir_Kind_Choice_By_None => - return "choice_by_none"; - when Iir_Kind_Choice_By_Name => - return "choice_by_name"; - when Iir_Kind_Entity_Aspect_Entity => - return "entity_aspect_entity"; - when Iir_Kind_Entity_Aspect_Configuration => - return "entity_aspect_configuration"; - when Iir_Kind_Entity_Aspect_Open => - return "entity_aspect_open"; - when Iir_Kind_Block_Configuration => - return "block_configuration"; - when Iir_Kind_Block_Header => - return "block_header"; - when Iir_Kind_Component_Configuration => - return "component_configuration"; - when Iir_Kind_Binding_Indication => - return "binding_indication"; - when Iir_Kind_Entity_Class => - return "entity_class"; - when Iir_Kind_Attribute_Value => - return "attribute_value"; - when Iir_Kind_Signature => - return "signature"; - when Iir_Kind_Aggregate_Info => - return "aggregate_info"; - when Iir_Kind_Procedure_Call => - return "procedure_call"; - when Iir_Kind_Record_Element_Constraint => - return "record_element_constraint"; - when Iir_Kind_Array_Element_Resolution => - return "array_element_resolution"; - when Iir_Kind_Record_Resolution => - return "record_resolution"; - when Iir_Kind_Record_Element_Resolution => - return "record_element_resolution"; - when Iir_Kind_Attribute_Specification => - return "attribute_specification"; - when Iir_Kind_Disconnection_Specification => - return "disconnection_specification"; - when Iir_Kind_Configuration_Specification => - return "configuration_specification"; - when Iir_Kind_Access_Type_Definition => - return "access_type_definition"; - when Iir_Kind_Incomplete_Type_Definition => - return "incomplete_type_definition"; - when Iir_Kind_File_Type_Definition => - return "file_type_definition"; - when Iir_Kind_Protected_Type_Declaration => - return "protected_type_declaration"; - when Iir_Kind_Record_Type_Definition => - return "record_type_definition"; - when Iir_Kind_Array_Type_Definition => - return "array_type_definition"; - when Iir_Kind_Array_Subtype_Definition => - return "array_subtype_definition"; - when Iir_Kind_Record_Subtype_Definition => - return "record_subtype_definition"; - when Iir_Kind_Access_Subtype_Definition => - return "access_subtype_definition"; - when Iir_Kind_Physical_Subtype_Definition => - return "physical_subtype_definition"; - when Iir_Kind_Floating_Subtype_Definition => - return "floating_subtype_definition"; - when Iir_Kind_Integer_Subtype_Definition => - return "integer_subtype_definition"; - when Iir_Kind_Enumeration_Subtype_Definition => - return "enumeration_subtype_definition"; - when Iir_Kind_Enumeration_Type_Definition => - return "enumeration_type_definition"; - when Iir_Kind_Integer_Type_Definition => - return "integer_type_definition"; - when Iir_Kind_Floating_Type_Definition => - return "floating_type_definition"; - when Iir_Kind_Physical_Type_Definition => - return "physical_type_definition"; - when Iir_Kind_Range_Expression => - return "range_expression"; - when Iir_Kind_Protected_Type_Body => - return "protected_type_body"; - when Iir_Kind_Subtype_Definition => - return "subtype_definition"; - when Iir_Kind_Scalar_Nature_Definition => - return "scalar_nature_definition"; - when Iir_Kind_Overload_List => - return "overload_list"; - when Iir_Kind_Type_Declaration => - return "type_declaration"; - when Iir_Kind_Anonymous_Type_Declaration => - return "anonymous_type_declaration"; - when Iir_Kind_Subtype_Declaration => - return "subtype_declaration"; - when Iir_Kind_Nature_Declaration => - return "nature_declaration"; - when Iir_Kind_Subnature_Declaration => - return "subnature_declaration"; - when Iir_Kind_Package_Declaration => - return "package_declaration"; - when Iir_Kind_Package_Instantiation_Declaration => - return "package_instantiation_declaration"; - when Iir_Kind_Package_Body => - return "package_body"; - when Iir_Kind_Configuration_Declaration => - return "configuration_declaration"; - when Iir_Kind_Entity_Declaration => - return "entity_declaration"; - when Iir_Kind_Architecture_Body => - return "architecture_body"; - when Iir_Kind_Package_Header => - return "package_header"; - when Iir_Kind_Unit_Declaration => - return "unit_declaration"; - when Iir_Kind_Library_Declaration => - return "library_declaration"; - when Iir_Kind_Component_Declaration => - return "component_declaration"; - when Iir_Kind_Attribute_Declaration => - return "attribute_declaration"; - when Iir_Kind_Group_Template_Declaration => - return "group_template_declaration"; - when Iir_Kind_Group_Declaration => - return "group_declaration"; - when Iir_Kind_Element_Declaration => - return "element_declaration"; - when Iir_Kind_Non_Object_Alias_Declaration => - return "non_object_alias_declaration"; - when Iir_Kind_Psl_Declaration => - return "psl_declaration"; - when Iir_Kind_Terminal_Declaration => - return "terminal_declaration"; - when Iir_Kind_Free_Quantity_Declaration => - return "free_quantity_declaration"; - when Iir_Kind_Across_Quantity_Declaration => - return "across_quantity_declaration"; - when Iir_Kind_Through_Quantity_Declaration => - return "through_quantity_declaration"; - when Iir_Kind_Enumeration_Literal => - return "enumeration_literal"; - when Iir_Kind_Function_Declaration => - return "function_declaration"; - when Iir_Kind_Implicit_Function_Declaration => - return "implicit_function_declaration"; - when Iir_Kind_Implicit_Procedure_Declaration => - return "implicit_procedure_declaration"; - when Iir_Kind_Procedure_Declaration => - return "procedure_declaration"; - when Iir_Kind_Function_Body => - return "function_body"; - when Iir_Kind_Procedure_Body => - return "procedure_body"; - when Iir_Kind_Object_Alias_Declaration => - return "object_alias_declaration"; - when Iir_Kind_File_Declaration => - return "file_declaration"; - when Iir_Kind_Guard_Signal_Declaration => - return "guard_signal_declaration"; - when Iir_Kind_Signal_Declaration => - return "signal_declaration"; - when Iir_Kind_Variable_Declaration => - return "variable_declaration"; - when Iir_Kind_Constant_Declaration => - return "constant_declaration"; - when Iir_Kind_Iterator_Declaration => - return "iterator_declaration"; - when Iir_Kind_Interface_Constant_Declaration => - return "interface_constant_declaration"; - when Iir_Kind_Interface_Variable_Declaration => - return "interface_variable_declaration"; - when Iir_Kind_Interface_Signal_Declaration => - return "interface_signal_declaration"; - when Iir_Kind_Interface_File_Declaration => - return "interface_file_declaration"; - when Iir_Kind_Interface_Package_Declaration => - return "interface_package_declaration"; - when Iir_Kind_Identity_Operator => - return "identity_operator"; - when Iir_Kind_Negation_Operator => - return "negation_operator"; - when Iir_Kind_Absolute_Operator => - return "absolute_operator"; - when Iir_Kind_Not_Operator => - return "not_operator"; - when Iir_Kind_Condition_Operator => - return "condition_operator"; - when Iir_Kind_Reduction_And_Operator => - return "reduction_and_operator"; - when Iir_Kind_Reduction_Or_Operator => - return "reduction_or_operator"; - when Iir_Kind_Reduction_Nand_Operator => - return "reduction_nand_operator"; - when Iir_Kind_Reduction_Nor_Operator => - return "reduction_nor_operator"; - when Iir_Kind_Reduction_Xor_Operator => - return "reduction_xor_operator"; - when Iir_Kind_Reduction_Xnor_Operator => - return "reduction_xnor_operator"; - when Iir_Kind_And_Operator => - return "and_operator"; - when Iir_Kind_Or_Operator => - return "or_operator"; - when Iir_Kind_Nand_Operator => - return "nand_operator"; - when Iir_Kind_Nor_Operator => - return "nor_operator"; - when Iir_Kind_Xor_Operator => - return "xor_operator"; - when Iir_Kind_Xnor_Operator => - return "xnor_operator"; - when Iir_Kind_Equality_Operator => - return "equality_operator"; - when Iir_Kind_Inequality_Operator => - return "inequality_operator"; - when Iir_Kind_Less_Than_Operator => - return "less_than_operator"; - when Iir_Kind_Less_Than_Or_Equal_Operator => - return "less_than_or_equal_operator"; - when Iir_Kind_Greater_Than_Operator => - return "greater_than_operator"; - when Iir_Kind_Greater_Than_Or_Equal_Operator => - return "greater_than_or_equal_operator"; - when Iir_Kind_Match_Equality_Operator => - return "match_equality_operator"; - when Iir_Kind_Match_Inequality_Operator => - return "match_inequality_operator"; - when Iir_Kind_Match_Less_Than_Operator => - return "match_less_than_operator"; - when Iir_Kind_Match_Less_Than_Or_Equal_Operator => - return "match_less_than_or_equal_operator"; - when Iir_Kind_Match_Greater_Than_Operator => - return "match_greater_than_operator"; - when Iir_Kind_Match_Greater_Than_Or_Equal_Operator => - return "match_greater_than_or_equal_operator"; - when Iir_Kind_Sll_Operator => - return "sll_operator"; - when Iir_Kind_Sla_Operator => - return "sla_operator"; - when Iir_Kind_Srl_Operator => - return "srl_operator"; - when Iir_Kind_Sra_Operator => - return "sra_operator"; - when Iir_Kind_Rol_Operator => - return "rol_operator"; - when Iir_Kind_Ror_Operator => - return "ror_operator"; - when Iir_Kind_Addition_Operator => - return "addition_operator"; - when Iir_Kind_Substraction_Operator => - return "substraction_operator"; - when Iir_Kind_Concatenation_Operator => - return "concatenation_operator"; - when Iir_Kind_Multiplication_Operator => - return "multiplication_operator"; - when Iir_Kind_Division_Operator => - return "division_operator"; - when Iir_Kind_Modulus_Operator => - return "modulus_operator"; - when Iir_Kind_Remainder_Operator => - return "remainder_operator"; - when Iir_Kind_Exponentiation_Operator => - return "exponentiation_operator"; - when Iir_Kind_Function_Call => - return "function_call"; - when Iir_Kind_Aggregate => - return "aggregate"; - when Iir_Kind_Parenthesis_Expression => - return "parenthesis_expression"; - when Iir_Kind_Qualified_Expression => - return "qualified_expression"; - when Iir_Kind_Type_Conversion => - return "type_conversion"; - when Iir_Kind_Allocator_By_Expression => - return "allocator_by_expression"; - when Iir_Kind_Allocator_By_Subtype => - return "allocator_by_subtype"; - when Iir_Kind_Selected_Element => - return "selected_element"; - when Iir_Kind_Dereference => - return "dereference"; - when Iir_Kind_Implicit_Dereference => - return "implicit_dereference"; - when Iir_Kind_Slice_Name => - return "slice_name"; - when Iir_Kind_Indexed_Name => - return "indexed_name"; - when Iir_Kind_Psl_Expression => - return "psl_expression"; - when Iir_Kind_Sensitized_Process_Statement => - return "sensitized_process_statement"; - when Iir_Kind_Process_Statement => - return "process_statement"; - when Iir_Kind_Concurrent_Conditional_Signal_Assignment => - return "concurrent_conditional_signal_assignment"; - when Iir_Kind_Concurrent_Selected_Signal_Assignment => - return "concurrent_selected_signal_assignment"; - when Iir_Kind_Concurrent_Assertion_Statement => - return "concurrent_assertion_statement"; - when Iir_Kind_Psl_Default_Clock => - return "psl_default_clock"; - when Iir_Kind_Psl_Assert_Statement => - return "psl_assert_statement"; - when Iir_Kind_Psl_Cover_Statement => - return "psl_cover_statement"; - when Iir_Kind_Concurrent_Procedure_Call_Statement => - return "concurrent_procedure_call_statement"; - when Iir_Kind_Block_Statement => - return "block_statement"; - when Iir_Kind_Generate_Statement => - return "generate_statement"; - when Iir_Kind_Component_Instantiation_Statement => - return "component_instantiation_statement"; - when Iir_Kind_Simple_Simultaneous_Statement => - return "simple_simultaneous_statement"; - when Iir_Kind_Signal_Assignment_Statement => - return "signal_assignment_statement"; - when Iir_Kind_Null_Statement => - return "null_statement"; - when Iir_Kind_Assertion_Statement => - return "assertion_statement"; - when Iir_Kind_Report_Statement => - return "report_statement"; - when Iir_Kind_Wait_Statement => - return "wait_statement"; - when Iir_Kind_Variable_Assignment_Statement => - return "variable_assignment_statement"; - when Iir_Kind_Return_Statement => - return "return_statement"; - when Iir_Kind_For_Loop_Statement => - return "for_loop_statement"; - when Iir_Kind_While_Loop_Statement => - return "while_loop_statement"; - when Iir_Kind_Next_Statement => - return "next_statement"; - when Iir_Kind_Exit_Statement => - return "exit_statement"; - when Iir_Kind_Case_Statement => - return "case_statement"; - when Iir_Kind_Procedure_Call_Statement => - return "procedure_call_statement"; - when Iir_Kind_If_Statement => - return "if_statement"; - when Iir_Kind_Elsif => - return "elsif"; - when Iir_Kind_Character_Literal => - return "character_literal"; - when Iir_Kind_Simple_Name => - return "simple_name"; - when Iir_Kind_Selected_Name => - return "selected_name"; - when Iir_Kind_Operator_Symbol => - return "operator_symbol"; - when Iir_Kind_Selected_By_All_Name => - return "selected_by_all_name"; - when Iir_Kind_Parenthesis_Name => - return "parenthesis_name"; - when Iir_Kind_Base_Attribute => - return "base_attribute"; - when Iir_Kind_Left_Type_Attribute => - return "left_type_attribute"; - when Iir_Kind_Right_Type_Attribute => - return "right_type_attribute"; - when Iir_Kind_High_Type_Attribute => - return "high_type_attribute"; - when Iir_Kind_Low_Type_Attribute => - return "low_type_attribute"; - when Iir_Kind_Ascending_Type_Attribute => - return "ascending_type_attribute"; - when Iir_Kind_Image_Attribute => - return "image_attribute"; - when Iir_Kind_Value_Attribute => - return "value_attribute"; - when Iir_Kind_Pos_Attribute => - return "pos_attribute"; - when Iir_Kind_Val_Attribute => - return "val_attribute"; - when Iir_Kind_Succ_Attribute => - return "succ_attribute"; - when Iir_Kind_Pred_Attribute => - return "pred_attribute"; - when Iir_Kind_Leftof_Attribute => - return "leftof_attribute"; - when Iir_Kind_Rightof_Attribute => - return "rightof_attribute"; - when Iir_Kind_Delayed_Attribute => - return "delayed_attribute"; - when Iir_Kind_Stable_Attribute => - return "stable_attribute"; - when Iir_Kind_Quiet_Attribute => - return "quiet_attribute"; - when Iir_Kind_Transaction_Attribute => - return "transaction_attribute"; - when Iir_Kind_Event_Attribute => - return "event_attribute"; - when Iir_Kind_Active_Attribute => - return "active_attribute"; - when Iir_Kind_Last_Event_Attribute => - return "last_event_attribute"; - when Iir_Kind_Last_Active_Attribute => - return "last_active_attribute"; - when Iir_Kind_Last_Value_Attribute => - return "last_value_attribute"; - when Iir_Kind_Driving_Attribute => - return "driving_attribute"; - when Iir_Kind_Driving_Value_Attribute => - return "driving_value_attribute"; - when Iir_Kind_Behavior_Attribute => - return "behavior_attribute"; - when Iir_Kind_Structure_Attribute => - return "structure_attribute"; - when Iir_Kind_Simple_Name_Attribute => - return "simple_name_attribute"; - when Iir_Kind_Instance_Name_Attribute => - return "instance_name_attribute"; - when Iir_Kind_Path_Name_Attribute => - return "path_name_attribute"; - when Iir_Kind_Left_Array_Attribute => - return "left_array_attribute"; - when Iir_Kind_Right_Array_Attribute => - return "right_array_attribute"; - when Iir_Kind_High_Array_Attribute => - return "high_array_attribute"; - when Iir_Kind_Low_Array_Attribute => - return "low_array_attribute"; - when Iir_Kind_Length_Array_Attribute => - return "length_array_attribute"; - when Iir_Kind_Ascending_Array_Attribute => - return "ascending_array_attribute"; - when Iir_Kind_Range_Array_Attribute => - return "range_array_attribute"; - when Iir_Kind_Reverse_Range_Array_Attribute => - return "reverse_range_array_attribute"; - when Iir_Kind_Attribute_Name => - return "attribute_name"; - end case; - end Get_Iir_Image; - - function Get_Field_Attribute (F : Fields_Enum) return Field_Attribute is - begin - case F is - when Field_First_Design_Unit => - return Attr_Chain; - when Field_Last_Design_Unit => - return Attr_Ref; - when Field_Library_Declaration => - return Attr_None; - when Field_File_Time_Stamp => - return Attr_None; - when Field_Analysis_Time_Stamp => - return Attr_None; - when Field_Library => - return Attr_Ref; - when Field_File_Dependence_List => - return Attr_None; - when Field_Design_File_Filename => - return Attr_None; - when Field_Design_File_Directory => - return Attr_None; - when Field_Design_File => - return Attr_Ref; - when Field_Design_File_Chain => - return Attr_Chain; - when Field_Library_Directory => - return Attr_None; - when Field_Date => - return Attr_None; - when Field_Context_Items => - return Attr_Chain; - when Field_Dependence_List => - return Attr_Of_Ref; - when Field_Analysis_Checks_List => - return Attr_None; - when Field_Date_State => - return Attr_None; - when Field_Guarded_Target_State => - return Attr_None; - when Field_Library_Unit => - return Attr_None; - when Field_Hash_Chain => - return Attr_Ref; - when Field_Design_Unit_Source_Pos => - return Attr_None; - when Field_Design_Unit_Source_Line => - return Attr_None; - when Field_Design_Unit_Source_Col => - return Attr_None; - when Field_Value => - return Attr_None; - when Field_Enum_Pos => - return Attr_None; - when Field_Physical_Literal => - return Attr_None; - when Field_Physical_Unit_Value => - return Attr_None; - when Field_Fp_Value => - return Attr_None; - when Field_Enumeration_Decl => - return Attr_Ref; - when Field_Simple_Aggregate_List => - return Attr_None; - when Field_Bit_String_Base => - return Attr_None; - when Field_Bit_String_0 => - return Attr_None; - when Field_Bit_String_1 => - return Attr_None; - when Field_Literal_Origin => - return Attr_None; - when Field_Range_Origin => - return Attr_None; - when Field_Literal_Subtype => - return Attr_None; - when Field_Entity_Class => - return Attr_None; - when Field_Entity_Name_List => - return Attr_None; - when Field_Attribute_Designator => - return Attr_None; - when Field_Attribute_Specification_Chain => - return Attr_None; - when Field_Attribute_Specification => - return Attr_Ref; - when Field_Signal_List => - return Attr_None; - when Field_Designated_Entity => - return Attr_Ref; - when Field_Formal => - return Attr_None; - when Field_Actual => - return Attr_None; - when Field_In_Conversion => - return Attr_None; - when Field_Out_Conversion => - return Attr_None; - when Field_Whole_Association_Flag => - return Attr_None; - when Field_Collapse_Signal_Flag => - return Attr_None; - when Field_Artificial_Flag => - return Attr_None; - when Field_Open_Flag => - return Attr_None; - when Field_After_Drivers_Flag => - return Attr_None; - when Field_We_Value => - return Attr_None; - when Field_Time => - return Attr_None; - when Field_Associated_Expr => - return Attr_None; - when Field_Associated_Chain => - return Attr_Chain; - when Field_Choice_Name => - return Attr_None; - when Field_Choice_Expression => - return Attr_None; - when Field_Choice_Range => - return Attr_None; - when Field_Same_Alternative_Flag => - return Attr_None; - when Field_Architecture => - return Attr_None; - when Field_Block_Specification => - return Attr_None; - when Field_Prev_Block_Configuration => - return Attr_Ref; - when Field_Configuration_Item_Chain => - return Attr_Chain; - when Field_Attribute_Value_Chain => - return Attr_Chain; - when Field_Spec_Chain => - return Attr_None; - when Field_Attribute_Value_Spec_Chain => - return Attr_None; - when Field_Entity_Name => - return Attr_None; - when Field_Package => - return Attr_Ref; - when Field_Package_Body => - return Attr_Ref; - when Field_Need_Body => - return Attr_None; - when Field_Block_Configuration => - return Attr_None; - when Field_Concurrent_Statement_Chain => - return Attr_Chain; - when Field_Chain => - return Attr_Chain_Next; - when Field_Port_Chain => - return Attr_Chain; - when Field_Generic_Chain => - return Attr_Chain; - when Field_Type => - return Attr_Ref; - when Field_Subtype_Indication => - return Attr_Maybe_Ref; - when Field_Discrete_Range => - return Attr_None; - when Field_Type_Definition => - return Attr_None; - when Field_Subtype_Definition => - return Attr_None; - when Field_Nature => - return Attr_None; - when Field_Mode => - return Attr_None; - when Field_Signal_Kind => - return Attr_None; - when Field_Base_Name => - return Attr_Ref; - when Field_Interface_Declaration_Chain => - return Attr_Chain; - when Field_Subprogram_Specification => - return Attr_Ref; - when Field_Sequential_Statement_Chain => - return Attr_Chain; - when Field_Subprogram_Body => - return Attr_Ref; - when Field_Overload_Number => - return Attr_None; - when Field_Subprogram_Depth => - return Attr_None; - when Field_Subprogram_Hash => - return Attr_None; - when Field_Impure_Depth => - return Attr_None; - when Field_Return_Type => - return Attr_Ref; - when Field_Implicit_Definition => - return Attr_None; - when Field_Type_Reference => - return Attr_Ref; - when Field_Default_Value => - return Attr_Maybe_Ref; - when Field_Deferred_Declaration => - return Attr_None; - when Field_Deferred_Declaration_Flag => - return Attr_None; - when Field_Shared_Flag => - return Attr_None; - when Field_Design_Unit => - return Attr_None; - when Field_Block_Statement => - return Attr_None; - when Field_Signal_Driver => - return Attr_None; - when Field_Declaration_Chain => - return Attr_Chain; - when Field_File_Logical_Name => - return Attr_None; - when Field_File_Open_Kind => - return Attr_None; - when Field_Element_Position => - return Attr_None; - when Field_Element_Declaration => - return Attr_None; - when Field_Selected_Element => - return Attr_Ref; - when Field_Use_Clause_Chain => - return Attr_None; - when Field_Selected_Name => - return Attr_None; - when Field_Type_Declarator => - return Attr_Ref; - when Field_Enumeration_Literal_List => - return Attr_None; - when Field_Entity_Class_Entry_Chain => - return Attr_Chain; - when Field_Group_Constituent_List => - return Attr_None; - when Field_Unit_Chain => - return Attr_Chain; - when Field_Primary_Unit => - return Attr_Ref; - when Field_Identifier => - return Attr_None; - when Field_Label => - return Attr_None; - when Field_Visible_Flag => - return Attr_None; - when Field_Range_Constraint => - return Attr_None; - when Field_Direction => - return Attr_None; - when Field_Left_Limit => - return Attr_None; - when Field_Right_Limit => - return Attr_None; - when Field_Base_Type => - return Attr_Ref; - when Field_Resolution_Indication => - return Attr_None; - when Field_Record_Element_Resolution_Chain => - return Attr_Chain; - when Field_Tolerance => - return Attr_None; - when Field_Plus_Terminal => - return Attr_None; - when Field_Minus_Terminal => - return Attr_None; - when Field_Simultaneous_Left => - return Attr_None; - when Field_Simultaneous_Right => - return Attr_None; - when Field_Text_File_Flag => - return Attr_None; - when Field_Only_Characters_Flag => - return Attr_None; - when Field_Type_Staticness => - return Attr_None; - when Field_Constraint_State => - return Attr_None; - when Field_Index_Subtype_List => - return Attr_Ref; - when Field_Index_Subtype_Definition_List => - return Attr_None; - when Field_Element_Subtype_Indication => - return Attr_None; - when Field_Element_Subtype => - return Attr_Ref; - when Field_Index_Constraint_List => - return Attr_None; - when Field_Array_Element_Constraint => - return Attr_None; - when Field_Elements_Declaration_List => - return Attr_None; - when Field_Designated_Type => - return Attr_Ref; - when Field_Designated_Subtype_Indication => - return Attr_None; - when Field_Index_List => - return Attr_None; - when Field_Reference => - return Attr_None; - when Field_Nature_Declarator => - return Attr_None; - when Field_Across_Type => - return Attr_None; - when Field_Through_Type => - return Attr_None; - when Field_Target => - return Attr_None; - when Field_Waveform_Chain => - return Attr_Chain; - when Field_Guard => - return Attr_None; - when Field_Delay_Mechanism => - return Attr_None; - when Field_Reject_Time_Expression => - return Attr_None; - when Field_Sensitivity_List => - return Attr_None; - when Field_Process_Origin => - return Attr_None; - when Field_Condition_Clause => - return Attr_None; - when Field_Timeout_Clause => - return Attr_None; - when Field_Postponed_Flag => - return Attr_None; - when Field_Callees_List => - return Attr_Of_Ref; - when Field_Passive_Flag => - return Attr_None; - when Field_Resolution_Function_Flag => - return Attr_None; - when Field_Wait_State => - return Attr_None; - when Field_All_Sensitized_State => - return Attr_None; - when Field_Seen_Flag => - return Attr_None; - when Field_Pure_Flag => - return Attr_None; - when Field_Foreign_Flag => - return Attr_None; - when Field_Resolved_Flag => - return Attr_None; - when Field_Signal_Type_Flag => - return Attr_None; - when Field_Has_Signal_Flag => - return Attr_None; - when Field_Purity_State => - return Attr_None; - when Field_Elab_Flag => - return Attr_None; - when Field_Index_Constraint_Flag => - return Attr_None; - when Field_Assertion_Condition => - return Attr_None; - when Field_Report_Expression => - return Attr_None; - when Field_Severity_Expression => - return Attr_None; - when Field_Instantiated_Unit => - return Attr_None; - when Field_Generic_Map_Aspect_Chain => - return Attr_Chain; - when Field_Port_Map_Aspect_Chain => - return Attr_Chain; - when Field_Configuration_Name => - return Attr_None; - when Field_Component_Configuration => - return Attr_None; - when Field_Configuration_Specification => - return Attr_None; - when Field_Default_Binding_Indication => - return Attr_None; - when Field_Default_Configuration_Declaration => - return Attr_None; - when Field_Expression => - return Attr_None; - when Field_Allocator_Designated_Type => - return Attr_Ref; - when Field_Selected_Waveform_Chain => - return Attr_Chain; - when Field_Conditional_Waveform_Chain => - return Attr_Chain; - when Field_Guard_Expression => - return Attr_None; - when Field_Guard_Decl => - return Attr_None; - when Field_Guard_Sensitivity_List => - return Attr_None; - when Field_Block_Block_Configuration => - return Attr_None; - when Field_Package_Header => - return Attr_None; - when Field_Block_Header => - return Attr_None; - when Field_Uninstantiated_Package_Name => - return Attr_None; - when Field_Generate_Block_Configuration => - return Attr_None; - when Field_Generation_Scheme => - return Attr_None; - when Field_Condition => - return Attr_None; - when Field_Else_Clause => - return Attr_None; - when Field_Parameter_Specification => - return Attr_None; - when Field_Parent => - return Attr_Ref; - when Field_Loop_Label => - return Attr_None; - when Field_Component_Name => - return Attr_None; - when Field_Instantiation_List => - return Attr_None; - when Field_Entity_Aspect => - return Attr_None; - when Field_Default_Entity_Aspect => - return Attr_None; - when Field_Default_Generic_Map_Aspect_Chain => - return Attr_Chain; - when Field_Default_Port_Map_Aspect_Chain => - return Attr_Chain; - when Field_Binding_Indication => - return Attr_None; - when Field_Named_Entity => - return Attr_Ref; - when Field_Alias_Declaration => - return Attr_None; - when Field_Expr_Staticness => - return Attr_None; - when Field_Error_Origin => - return Attr_None; - when Field_Operand => - return Attr_None; - when Field_Left => - return Attr_None; - when Field_Right => - return Attr_None; - when Field_Unit_Name => - return Attr_None; - when Field_Name => - return Attr_None; - when Field_Group_Template_Name => - return Attr_None; - when Field_Name_Staticness => - return Attr_None; - when Field_Prefix => - return Attr_None; - when Field_Signature_Prefix => - return Attr_Ref; - when Field_Slice_Subtype => - return Attr_None; - when Field_Suffix => - return Attr_None; - when Field_Index_Subtype => - return Attr_None; - when Field_Parameter => - return Attr_None; - when Field_Actual_Type => - return Attr_None; - when Field_Associated_Interface => - return Attr_Ref; - when Field_Association_Chain => - return Attr_Chain; - when Field_Individual_Association_Chain => - return Attr_Chain; - when Field_Aggregate_Info => - return Attr_None; - when Field_Sub_Aggregate_Info => - return Attr_None; - when Field_Aggr_Dynamic_Flag => - return Attr_None; - when Field_Aggr_Min_Length => - return Attr_None; - when Field_Aggr_Low_Limit => - return Attr_None; - when Field_Aggr_High_Limit => - return Attr_None; - when Field_Aggr_Others_Flag => - return Attr_None; - when Field_Aggr_Named_Flag => - return Attr_None; - when Field_Value_Staticness => - return Attr_None; - when Field_Association_Choices_Chain => - return Attr_Chain; - when Field_Case_Statement_Alternative_Chain => - return Attr_Chain; - when Field_Choice_Staticness => - return Attr_None; - when Field_Procedure_Call => - return Attr_None; - when Field_Implementation => - return Attr_Ref; - when Field_Parameter_Association_Chain => - return Attr_Chain; - when Field_Method_Object => - return Attr_None; - when Field_Subtype_Type_Mark => - return Attr_None; - when Field_Type_Conversion_Subtype => - return Attr_None; - when Field_Type_Mark => - return Attr_None; - when Field_File_Type_Mark => - return Attr_None; - when Field_Return_Type_Mark => - return Attr_None; - when Field_Lexical_Layout => - return Attr_None; - when Field_Incomplete_Type_List => - return Attr_None; - when Field_Has_Disconnect_Flag => - return Attr_None; - when Field_Has_Active_Flag => - return Attr_None; - when Field_Is_Within_Flag => - return Attr_None; - when Field_Type_Marks_List => - return Attr_None; - when Field_Implicit_Alias_Flag => - return Attr_None; - when Field_Alias_Signature => - return Attr_None; - when Field_Attribute_Signature => - return Attr_None; - when Field_Overload_List => - return Attr_Of_Ref; - when Field_Simple_Name_Identifier => - return Attr_None; - when Field_Simple_Name_Subtype => - return Attr_None; - when Field_Protected_Type_Body => - return Attr_None; - when Field_Protected_Type_Declaration => - return Attr_None; - when Field_End_Location => - return Attr_None; - when Field_String_Id => - return Attr_None; - when Field_String_Length => - return Attr_None; - when Field_Use_Flag => - return Attr_None; - when Field_End_Has_Reserved_Id => - return Attr_None; - when Field_End_Has_Identifier => - return Attr_None; - when Field_End_Has_Postponed => - return Attr_None; - when Field_Has_Begin => - return Attr_None; - when Field_Has_Is => - return Attr_None; - when Field_Has_Pure => - return Attr_None; - when Field_Has_Body => - return Attr_None; - when Field_Has_Identifier_List => - return Attr_None; - when Field_Has_Mode => - return Attr_None; - when Field_Is_Ref => - return Attr_None; - when Field_Psl_Property => - return Attr_None; - when Field_Psl_Declaration => - return Attr_None; - when Field_Psl_Expression => - return Attr_None; - when Field_Psl_Boolean => - return Attr_None; - when Field_PSL_Clock => - return Attr_None; - when Field_PSL_NFA => - return Attr_None; - end case; - end Get_Field_Attribute; - - Fields_Of_Iir : constant Fields_Array := - ( - -- Iir_Kind_Unused - -- Iir_Kind_Error - Field_Resolved_Flag, - Field_Signal_Type_Flag, - Field_Has_Signal_Flag, - Field_Expr_Staticness, - Field_Error_Origin, - Field_Type, - Field_Type_Declarator, - Field_Base_Type, - -- Iir_Kind_Design_File - Field_Design_File_Directory, - Field_Design_File_Filename, - Field_Analysis_Time_Stamp, - Field_File_Time_Stamp, - Field_Elab_Flag, - Field_File_Dependence_List, - Field_Chain, - Field_First_Design_Unit, - Field_Library, - Field_Last_Design_Unit, - -- Iir_Kind_Design_Unit - Field_Date, - Field_Design_Unit_Source_Line, - Field_Design_Unit_Source_Col, - Field_Identifier, - Field_Design_Unit_Source_Pos, - Field_End_Location, - Field_Elab_Flag, - Field_Date_State, - Field_Context_Items, - Field_Chain, - Field_Library_Unit, - Field_Analysis_Checks_List, - Field_Design_File, - Field_Hash_Chain, - Field_Dependence_List, - -- Iir_Kind_Library_Clause - Field_Identifier, - Field_Has_Identifier_List, - Field_Library_Declaration, - Field_Chain, - Field_Parent, - -- Iir_Kind_Use_Clause - Field_Selected_Name, - Field_Chain, - Field_Use_Clause_Chain, - Field_Parent, - -- Iir_Kind_Integer_Literal - Field_Value, - Field_Expr_Staticness, - Field_Literal_Origin, - Field_Type, - -- Iir_Kind_Floating_Point_Literal - Field_Fp_Value, - Field_Expr_Staticness, - Field_Literal_Origin, - Field_Type, - -- Iir_Kind_Null_Literal - Field_Expr_Staticness, - Field_Type, - -- Iir_Kind_String_Literal - Field_String_Id, - Field_String_Length, - Field_Expr_Staticness, - Field_Literal_Origin, - Field_Literal_Subtype, - Field_Type, - -- Iir_Kind_Physical_Int_Literal - Field_Value, - Field_Expr_Staticness, - Field_Literal_Origin, - Field_Unit_Name, - Field_Type, - -- Iir_Kind_Physical_Fp_Literal - Field_Fp_Value, - Field_Expr_Staticness, - Field_Literal_Origin, - Field_Unit_Name, - Field_Type, - -- Iir_Kind_Bit_String_Literal - Field_String_Id, - Field_String_Length, - Field_Bit_String_Base, - Field_Expr_Staticness, - Field_Literal_Origin, - Field_Literal_Subtype, - Field_Bit_String_0, - Field_Bit_String_1, - Field_Type, - -- Iir_Kind_Simple_Aggregate - Field_Expr_Staticness, - Field_Literal_Origin, - Field_Simple_Aggregate_List, - Field_Literal_Subtype, - Field_Type, - -- Iir_Kind_Overflow_Literal - Field_Expr_Staticness, - Field_Literal_Origin, - Field_Type, - -- Iir_Kind_Waveform_Element - Field_We_Value, - Field_Chain, - Field_Time, - -- Iir_Kind_Conditional_Waveform - Field_Condition, - Field_Chain, - Field_Waveform_Chain, - -- Iir_Kind_Association_Element_By_Expression - Field_Whole_Association_Flag, - Field_Collapse_Signal_Flag, - Field_Formal, - Field_Chain, - Field_Actual, - Field_In_Conversion, - Field_Out_Conversion, - -- Iir_Kind_Association_Element_By_Individual - Field_Whole_Association_Flag, - Field_Collapse_Signal_Flag, - Field_Formal, - Field_Chain, - Field_Actual_Type, - Field_Individual_Association_Chain, - -- Iir_Kind_Association_Element_Open - Field_Whole_Association_Flag, - Field_Collapse_Signal_Flag, - Field_Artificial_Flag, - Field_Formal, - Field_Chain, - -- Iir_Kind_Association_Element_Package - Field_Whole_Association_Flag, - Field_Collapse_Signal_Flag, - Field_Formal, - Field_Chain, - Field_Actual, - Field_Associated_Interface, - -- Iir_Kind_Choice_By_Others - Field_Same_Alternative_Flag, - Field_Chain, - Field_Associated_Expr, - Field_Associated_Chain, - Field_Parent, - -- Iir_Kind_Choice_By_Expression - Field_Same_Alternative_Flag, - Field_Choice_Staticness, - Field_Chain, - Field_Associated_Expr, - Field_Associated_Chain, - Field_Choice_Expression, - Field_Parent, - -- Iir_Kind_Choice_By_Range - Field_Same_Alternative_Flag, - Field_Choice_Staticness, - Field_Chain, - Field_Associated_Expr, - Field_Associated_Chain, - Field_Choice_Range, - Field_Parent, - -- Iir_Kind_Choice_By_None - Field_Same_Alternative_Flag, - Field_Chain, - Field_Associated_Expr, - Field_Associated_Chain, - Field_Parent, - -- Iir_Kind_Choice_By_Name - Field_Same_Alternative_Flag, - Field_Chain, - Field_Associated_Expr, - Field_Associated_Chain, - Field_Choice_Name, - Field_Parent, - -- Iir_Kind_Entity_Aspect_Entity - Field_Entity_Name, - Field_Architecture, - -- Iir_Kind_Entity_Aspect_Configuration - Field_Configuration_Name, - -- Iir_Kind_Entity_Aspect_Open - -- Iir_Kind_Block_Configuration - Field_Declaration_Chain, - Field_Chain, - Field_Configuration_Item_Chain, - Field_Block_Specification, - Field_Parent, - Field_Prev_Block_Configuration, - -- Iir_Kind_Block_Header - Field_Generic_Chain, - Field_Port_Chain, - Field_Generic_Map_Aspect_Chain, - Field_Port_Map_Aspect_Chain, - -- Iir_Kind_Component_Configuration - Field_Instantiation_List, - Field_Chain, - Field_Binding_Indication, - Field_Component_Name, - Field_Block_Configuration, - Field_Parent, - -- Iir_Kind_Binding_Indication - Field_Default_Entity_Aspect, - Field_Entity_Aspect, - Field_Default_Generic_Map_Aspect_Chain, - Field_Default_Port_Map_Aspect_Chain, - Field_Generic_Map_Aspect_Chain, - Field_Port_Map_Aspect_Chain, - -- Iir_Kind_Entity_Class - Field_Entity_Class, - Field_Chain, - -- Iir_Kind_Attribute_Value - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Spec_Chain, - Field_Chain, - Field_Type, - Field_Designated_Entity, - Field_Attribute_Specification, - Field_Base_Name, - -- Iir_Kind_Signature - Field_Type_Marks_List, - Field_Return_Type_Mark, - Field_Signature_Prefix, - -- Iir_Kind_Aggregate_Info - Field_Aggr_Min_Length, - Field_Aggr_Others_Flag, - Field_Aggr_Dynamic_Flag, - Field_Aggr_Named_Flag, - Field_Sub_Aggregate_Info, - Field_Aggr_Low_Limit, - Field_Aggr_High_Limit, - -- Iir_Kind_Procedure_Call - Field_Prefix, - Field_Parameter_Association_Chain, - Field_Method_Object, - Field_Implementation, - -- Iir_Kind_Record_Element_Constraint - Field_Identifier, - Field_Element_Position, - Field_Visible_Flag, - Field_Element_Declaration, - Field_Parent, - Field_Type, - -- Iir_Kind_Array_Element_Resolution - Field_Resolution_Indication, - -- Iir_Kind_Record_Resolution - Field_Record_Element_Resolution_Chain, - -- Iir_Kind_Record_Element_Resolution - Field_Identifier, - Field_Chain, - Field_Resolution_Indication, - -- Iir_Kind_Attribute_Specification - Field_Entity_Class, - Field_Entity_Name_List, - Field_Chain, - Field_Attribute_Value_Spec_Chain, - Field_Expression, - Field_Attribute_Designator, - Field_Attribute_Specification_Chain, - Field_Parent, - -- Iir_Kind_Disconnection_Specification - Field_Chain, - Field_Signal_List, - Field_Type_Mark, - Field_Expression, - Field_Parent, - -- Iir_Kind_Configuration_Specification - Field_Instantiation_List, - Field_Chain, - Field_Binding_Indication, - Field_Component_Name, - Field_Parent, - -- Iir_Kind_Access_Type_Definition - Field_Resolved_Flag, - Field_Signal_Type_Flag, - Field_Type_Staticness, - Field_Designated_Subtype_Indication, - Field_Designated_Type, - Field_Type_Declarator, - Field_Base_Type, - -- Iir_Kind_Incomplete_Type_Definition - Field_Resolved_Flag, - Field_Signal_Type_Flag, - Field_Has_Signal_Flag, - Field_Type_Staticness, - Field_Incomplete_Type_List, - Field_Type_Declarator, - Field_Base_Type, - -- Iir_Kind_File_Type_Definition - Field_Resolved_Flag, - Field_Signal_Type_Flag, - Field_Text_File_Flag, - Field_Type_Staticness, - Field_File_Type_Mark, - Field_Type_Declarator, - Field_Base_Type, - -- Iir_Kind_Protected_Type_Declaration - Field_Resolved_Flag, - Field_Signal_Type_Flag, - Field_End_Has_Reserved_Id, - Field_End_Has_Identifier, - Field_Type_Staticness, - Field_Declaration_Chain, - Field_Protected_Type_Body, - Field_Type_Declarator, - Field_Base_Type, - -- Iir_Kind_Record_Type_Definition - Field_Resolved_Flag, - Field_Signal_Type_Flag, - Field_Has_Signal_Flag, - Field_End_Has_Reserved_Id, - Field_End_Has_Identifier, - Field_Type_Staticness, - Field_Constraint_State, - Field_Elements_Declaration_List, - Field_Type_Declarator, - Field_Base_Type, - -- Iir_Kind_Array_Type_Definition - Field_Resolved_Flag, - Field_Signal_Type_Flag, - Field_Has_Signal_Flag, - Field_Index_Constraint_Flag, - Field_Type_Staticness, - Field_Constraint_State, - Field_Element_Subtype_Indication, - Field_Index_Subtype_Definition_List, - Field_Element_Subtype, - Field_Type_Declarator, - Field_Base_Type, - Field_Index_Subtype_List, - -- Iir_Kind_Array_Subtype_Definition - Field_Resolved_Flag, - Field_Signal_Type_Flag, - Field_Has_Signal_Flag, - Field_Index_Constraint_Flag, - Field_Type_Staticness, - Field_Constraint_State, - Field_Subtype_Type_Mark, - Field_Resolution_Indication, - Field_Index_Constraint_List, - Field_Tolerance, - Field_Array_Element_Constraint, - Field_Element_Subtype, - Field_Type_Declarator, - Field_Base_Type, - Field_Index_Subtype_List, - -- Iir_Kind_Record_Subtype_Definition - Field_Resolved_Flag, - Field_Signal_Type_Flag, - Field_Has_Signal_Flag, - Field_Type_Staticness, - Field_Constraint_State, - Field_Elements_Declaration_List, - Field_Subtype_Type_Mark, - Field_Resolution_Indication, - Field_Tolerance, - Field_Type_Declarator, - Field_Base_Type, - -- Iir_Kind_Access_Subtype_Definition - Field_Resolved_Flag, - Field_Signal_Type_Flag, - Field_Type_Staticness, - Field_Subtype_Type_Mark, - Field_Designated_Subtype_Indication, - Field_Designated_Type, - Field_Type_Declarator, - Field_Base_Type, - -- Iir_Kind_Physical_Subtype_Definition - Field_Resolved_Flag, - Field_Signal_Type_Flag, - Field_Has_Signal_Flag, - Field_Type_Staticness, - Field_Range_Constraint, - Field_Subtype_Type_Mark, - Field_Resolution_Indication, - Field_Type_Declarator, - Field_Base_Type, - -- Iir_Kind_Floating_Subtype_Definition - Field_Resolved_Flag, - Field_Signal_Type_Flag, - Field_Has_Signal_Flag, - Field_Type_Staticness, - Field_Range_Constraint, - Field_Subtype_Type_Mark, - Field_Resolution_Indication, - Field_Tolerance, - Field_Type_Declarator, - Field_Base_Type, - -- Iir_Kind_Integer_Subtype_Definition - Field_Resolved_Flag, - Field_Signal_Type_Flag, - Field_Has_Signal_Flag, - Field_Type_Staticness, - Field_Range_Constraint, - Field_Subtype_Type_Mark, - Field_Resolution_Indication, - Field_Type_Declarator, - Field_Base_Type, - -- Iir_Kind_Enumeration_Subtype_Definition - Field_Resolved_Flag, - Field_Signal_Type_Flag, - Field_Has_Signal_Flag, - Field_Type_Staticness, - Field_Range_Constraint, - Field_Subtype_Type_Mark, - Field_Resolution_Indication, - Field_Type_Declarator, - Field_Base_Type, - -- Iir_Kind_Enumeration_Type_Definition - Field_Resolved_Flag, - Field_Signal_Type_Flag, - Field_Has_Signal_Flag, - Field_Only_Characters_Flag, - Field_Type_Staticness, - Field_Range_Constraint, - Field_Enumeration_Literal_List, - Field_Type_Declarator, - Field_Base_Type, - -- Iir_Kind_Integer_Type_Definition - Field_Resolved_Flag, - Field_Signal_Type_Flag, - Field_Has_Signal_Flag, - Field_Type_Staticness, - Field_Type_Declarator, - Field_Base_Type, - -- Iir_Kind_Floating_Type_Definition - Field_Resolved_Flag, - Field_Signal_Type_Flag, - Field_Has_Signal_Flag, - Field_Type_Staticness, - Field_Type_Declarator, - Field_Base_Type, - -- Iir_Kind_Physical_Type_Definition - Field_Resolved_Flag, - Field_Signal_Type_Flag, - Field_Has_Signal_Flag, - Field_End_Has_Reserved_Id, - Field_End_Has_Identifier, - Field_Type_Staticness, - Field_Unit_Chain, - Field_Type_Declarator, - Field_Base_Type, - -- Iir_Kind_Range_Expression - Field_Expr_Staticness, - Field_Direction, - Field_Left_Limit, - Field_Right_Limit, - Field_Range_Origin, - Field_Type, - -- Iir_Kind_Protected_Type_Body - Field_Identifier, - Field_End_Has_Reserved_Id, - Field_End_Has_Identifier, - Field_Declaration_Chain, - Field_Chain, - Field_Protected_Type_Declaration, - Field_Parent, - -- Iir_Kind_Subtype_Definition - Field_Range_Constraint, - Field_Subtype_Type_Mark, - Field_Resolution_Indication, - Field_Tolerance, - -- Iir_Kind_Scalar_Nature_Definition - Field_Reference, - Field_Nature_Declarator, - Field_Across_Type, - Field_Through_Type, - -- Iir_Kind_Overload_List - Field_Overload_List, - -- Iir_Kind_Type_Declaration - Field_Identifier, - Field_Visible_Flag, - Field_Use_Flag, - Field_Type_Definition, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Parent, - -- Iir_Kind_Anonymous_Type_Declaration - Field_Identifier, - Field_Type_Definition, - Field_Chain, - Field_Subtype_Definition, - Field_Parent, - -- Iir_Kind_Subtype_Declaration - Field_Identifier, - Field_Visible_Flag, - Field_Use_Flag, - Field_Is_Ref, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Subtype_Indication, - Field_Parent, - Field_Type, - -- Iir_Kind_Nature_Declaration - Field_Identifier, - Field_Visible_Flag, - Field_Use_Flag, - Field_Nature, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Parent, - -- Iir_Kind_Subnature_Declaration - Field_Identifier, - Field_Visible_Flag, - Field_Use_Flag, - Field_Nature, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Parent, - -- Iir_Kind_Package_Declaration - Field_Identifier, - Field_Need_Body, - Field_Visible_Flag, - Field_End_Has_Reserved_Id, - Field_End_Has_Identifier, - Field_Declaration_Chain, - Field_Attribute_Value_Chain, - Field_Package_Header, - Field_Parent, - Field_Package_Body, - -- Iir_Kind_Package_Instantiation_Declaration - Field_Identifier, - Field_Visible_Flag, - Field_End_Has_Reserved_Id, - Field_End_Has_Identifier, - Field_Declaration_Chain, - Field_Attribute_Value_Chain, - Field_Uninstantiated_Package_Name, - Field_Generic_Chain, - Field_Generic_Map_Aspect_Chain, - Field_Parent, - Field_Package_Body, - -- Iir_Kind_Package_Body - Field_Identifier, - Field_End_Has_Reserved_Id, - Field_End_Has_Identifier, - Field_Declaration_Chain, - Field_Parent, - Field_Package, - -- Iir_Kind_Configuration_Declaration - Field_Identifier, - Field_Visible_Flag, - Field_End_Has_Reserved_Id, - Field_End_Has_Identifier, - Field_Declaration_Chain, - Field_Entity_Name, - Field_Attribute_Value_Chain, - Field_Block_Configuration, - Field_Parent, - -- Iir_Kind_Entity_Declaration - Field_Identifier, - Field_Has_Begin, - Field_Visible_Flag, - Field_Is_Within_Flag, - Field_End_Has_Reserved_Id, - Field_End_Has_Identifier, - Field_Declaration_Chain, - Field_Attribute_Value_Chain, - Field_Concurrent_Statement_Chain, - Field_Generic_Chain, - Field_Port_Chain, - Field_Parent, - -- Iir_Kind_Architecture_Body - Field_Identifier, - Field_Foreign_Flag, - Field_Visible_Flag, - Field_Is_Within_Flag, - Field_End_Has_Reserved_Id, - Field_End_Has_Identifier, - Field_Declaration_Chain, - Field_Entity_Name, - Field_Attribute_Value_Chain, - Field_Concurrent_Statement_Chain, - Field_Default_Configuration_Declaration, - Field_Parent, - -- Iir_Kind_Package_Header - Field_Generic_Chain, - Field_Generic_Map_Aspect_Chain, - -- Iir_Kind_Unit_Declaration - Field_Identifier, - Field_Visible_Flag, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Physical_Literal, - Field_Physical_Unit_Value, - Field_Parent, - Field_Type, - -- Iir_Kind_Library_Declaration - Field_Date, - Field_Library_Directory, - Field_Identifier, - Field_Visible_Flag, - Field_Design_File_Chain, - Field_Chain, - -- Iir_Kind_Component_Declaration - Field_Identifier, - Field_Visible_Flag, - Field_Use_Flag, - Field_Has_Is, - Field_End_Has_Reserved_Id, - Field_End_Has_Identifier, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Generic_Chain, - Field_Port_Chain, - Field_Parent, - -- Iir_Kind_Attribute_Declaration - Field_Identifier, - Field_Visible_Flag, - Field_Use_Flag, - Field_Chain, - Field_Type_Mark, - Field_Parent, - Field_Type, - -- Iir_Kind_Group_Template_Declaration - Field_Identifier, - Field_Visible_Flag, - Field_Use_Flag, - Field_Entity_Class_Entry_Chain, - Field_Chain, - Field_Parent, - -- Iir_Kind_Group_Declaration - Field_Identifier, - Field_Visible_Flag, - Field_Use_Flag, - Field_Group_Constituent_List, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Group_Template_Name, - Field_Parent, - -- Iir_Kind_Element_Declaration - Field_Identifier, - Field_Element_Position, - Field_Has_Identifier_List, - Field_Visible_Flag, - Field_Is_Ref, - Field_Subtype_Indication, - Field_Type, - -- Iir_Kind_Non_Object_Alias_Declaration - Field_Identifier, - Field_Implicit_Alias_Flag, - Field_Visible_Flag, - Field_Use_Flag, - Field_Chain, - Field_Name, - Field_Alias_Signature, - Field_Parent, - -- Iir_Kind_Psl_Declaration - Field_Psl_Declaration, - Field_Identifier, - Field_PSL_Clock, - Field_PSL_NFA, - Field_Visible_Flag, - Field_Use_Flag, - Field_Chain, - Field_Parent, - -- Iir_Kind_Terminal_Declaration - Field_Identifier, - Field_Visible_Flag, - Field_Use_Flag, - Field_Nature, - Field_Chain, - Field_Parent, - -- Iir_Kind_Free_Quantity_Declaration - Field_Identifier, - Field_Visible_Flag, - Field_Use_Flag, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Default_Value, - Field_Parent, - Field_Type, - -- Iir_Kind_Across_Quantity_Declaration - Field_Identifier, - Field_Visible_Flag, - Field_Use_Flag, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Tolerance, - Field_Plus_Terminal, - Field_Minus_Terminal, - Field_Default_Value, - Field_Parent, - Field_Type, - -- Iir_Kind_Through_Quantity_Declaration - Field_Identifier, - Field_Visible_Flag, - Field_Use_Flag, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Tolerance, - Field_Plus_Terminal, - Field_Minus_Terminal, - Field_Default_Value, - Field_Parent, - Field_Type, - -- Iir_Kind_Enumeration_Literal - Field_Enum_Pos, - Field_Subprogram_Hash, - Field_Identifier, - Field_Seen_Flag, - Field_Visible_Flag, - Field_Is_Within_Flag, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Literal_Origin, - Field_Attribute_Value_Chain, - Field_Parent, - Field_Type, - Field_Enumeration_Decl, - -- Iir_Kind_Function_Declaration - Field_Subprogram_Depth, - Field_Subprogram_Hash, - Field_Overload_Number, - Field_Identifier, - Field_Seen_Flag, - Field_Pure_Flag, - Field_Foreign_Flag, - Field_Visible_Flag, - Field_Is_Within_Flag, - Field_Use_Flag, - Field_Resolution_Function_Flag, - Field_Has_Pure, - Field_Has_Body, - Field_Wait_State, - Field_All_Sensitized_State, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Interface_Declaration_Chain, - Field_Generic_Chain, - Field_Return_Type_Mark, - Field_Parent, - Field_Return_Type, - Field_Subprogram_Body, - -- Iir_Kind_Implicit_Function_Declaration - Field_Subprogram_Hash, - Field_Overload_Number, - Field_Identifier, - Field_Implicit_Definition, - Field_Seen_Flag, - Field_Pure_Flag, - Field_Visible_Flag, - Field_Is_Within_Flag, - Field_Use_Flag, - Field_Wait_State, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Interface_Declaration_Chain, - Field_Generic_Chain, - Field_Generic_Map_Aspect_Chain, - Field_Parent, - Field_Return_Type, - Field_Type_Reference, - -- Iir_Kind_Implicit_Procedure_Declaration - Field_Subprogram_Hash, - Field_Overload_Number, - Field_Identifier, - Field_Implicit_Definition, - Field_Seen_Flag, - Field_Visible_Flag, - Field_Is_Within_Flag, - Field_Use_Flag, - Field_Wait_State, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Interface_Declaration_Chain, - Field_Generic_Chain, - Field_Generic_Map_Aspect_Chain, - Field_Parent, - Field_Type_Reference, - -- Iir_Kind_Procedure_Declaration - Field_Subprogram_Depth, - Field_Subprogram_Hash, - Field_Overload_Number, - Field_Identifier, - Field_Seen_Flag, - Field_Passive_Flag, - Field_Foreign_Flag, - Field_Visible_Flag, - Field_Is_Within_Flag, - Field_Use_Flag, - Field_Has_Body, - Field_Wait_State, - Field_Purity_State, - Field_All_Sensitized_State, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Interface_Declaration_Chain, - Field_Generic_Chain, - Field_Return_Type_Mark, - Field_Parent, - Field_Subprogram_Body, - -- Iir_Kind_Function_Body - Field_Impure_Depth, - Field_End_Has_Reserved_Id, - Field_End_Has_Identifier, - Field_Declaration_Chain, - Field_Chain, - Field_Sequential_Statement_Chain, - Field_Parent, - Field_Subprogram_Specification, - Field_Callees_List, - -- Iir_Kind_Procedure_Body - Field_Impure_Depth, - Field_End_Has_Reserved_Id, - Field_End_Has_Identifier, - Field_Declaration_Chain, - Field_Chain, - Field_Sequential_Statement_Chain, - Field_Parent, - Field_Subprogram_Specification, - Field_Callees_List, - -- Iir_Kind_Object_Alias_Declaration - Field_Identifier, - Field_Visible_Flag, - Field_After_Drivers_Flag, - Field_Use_Flag, - Field_Is_Ref, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Chain, - Field_Name, - Field_Subtype_Indication, - Field_Parent, - Field_Type, - -- Iir_Kind_File_Declaration - Field_Identifier, - Field_Has_Identifier_List, - Field_Visible_Flag, - Field_Use_Flag, - Field_Is_Ref, - Field_Has_Mode, - Field_Mode, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Chain, - Field_Attribute_Value_Chain, - Field_File_Logical_Name, - Field_File_Open_Kind, - Field_Subtype_Indication, - Field_Parent, - Field_Type, - -- Iir_Kind_Guard_Signal_Declaration - Field_Identifier, - Field_Has_Active_Flag, - Field_Visible_Flag, - Field_Use_Flag, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Signal_Kind, - Field_Guard_Expression, - Field_Attribute_Value_Chain, - Field_Guard_Sensitivity_List, - Field_Block_Statement, - Field_Parent, - Field_Type, - -- Iir_Kind_Signal_Declaration - Field_Identifier, - Field_Has_Disconnect_Flag, - Field_Has_Active_Flag, - Field_Has_Identifier_List, - Field_Visible_Flag, - Field_After_Drivers_Flag, - Field_Use_Flag, - Field_Is_Ref, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Signal_Kind, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Signal_Driver, - Field_Subtype_Indication, - Field_Default_Value, - Field_Parent, - Field_Type, - -- Iir_Kind_Variable_Declaration - Field_Identifier, - Field_Shared_Flag, - Field_Has_Identifier_List, - Field_Visible_Flag, - Field_Use_Flag, - Field_Is_Ref, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Subtype_Indication, - Field_Default_Value, - Field_Parent, - Field_Type, - -- Iir_Kind_Constant_Declaration - Field_Identifier, - Field_Deferred_Declaration_Flag, - Field_Has_Identifier_List, - Field_Visible_Flag, - Field_Use_Flag, - Field_Is_Ref, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Deferred_Declaration, - Field_Subtype_Indication, - Field_Default_Value, - Field_Parent, - Field_Type, - -- Iir_Kind_Iterator_Declaration - Field_Identifier, - Field_Has_Identifier_List, - Field_Visible_Flag, - Field_Use_Flag, - Field_Is_Ref, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Discrete_Range, - Field_Subtype_Indication, - Field_Parent, - Field_Type, - -- Iir_Kind_Interface_Constant_Declaration - Field_Identifier, - Field_Visible_Flag, - Field_After_Drivers_Flag, - Field_Use_Flag, - Field_Is_Ref, - Field_Mode, - Field_Lexical_Layout, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Subtype_Indication, - Field_Default_Value, - Field_Parent, - Field_Type, - -- Iir_Kind_Interface_Variable_Declaration - Field_Identifier, - Field_Visible_Flag, - Field_After_Drivers_Flag, - Field_Use_Flag, - Field_Is_Ref, - Field_Mode, - Field_Lexical_Layout, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Subtype_Indication, - Field_Default_Value, - Field_Parent, - Field_Type, - -- Iir_Kind_Interface_Signal_Declaration - Field_Identifier, - Field_Has_Disconnect_Flag, - Field_Has_Active_Flag, - Field_Open_Flag, - Field_Visible_Flag, - Field_After_Drivers_Flag, - Field_Use_Flag, - Field_Is_Ref, - Field_Mode, - Field_Lexical_Layout, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Signal_Kind, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Subtype_Indication, - Field_Default_Value, - Field_Parent, - Field_Type, - -- Iir_Kind_Interface_File_Declaration - Field_Identifier, - Field_Visible_Flag, - Field_After_Drivers_Flag, - Field_Use_Flag, - Field_Is_Ref, - Field_Mode, - Field_Lexical_Layout, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Subtype_Indication, - Field_Default_Value, - Field_Parent, - Field_Type, - -- Iir_Kind_Interface_Package_Declaration - Field_Identifier, - Field_Visible_Flag, - Field_Declaration_Chain, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Uninstantiated_Package_Name, - Field_Generic_Chain, - Field_Generic_Map_Aspect_Chain, - Field_Parent, - -- Iir_Kind_Identity_Operator - Field_Expr_Staticness, - Field_Operand, - Field_Type, - Field_Implementation, - -- Iir_Kind_Negation_Operator - Field_Expr_Staticness, - Field_Operand, - Field_Type, - Field_Implementation, - -- Iir_Kind_Absolute_Operator - Field_Expr_Staticness, - Field_Operand, - Field_Type, - Field_Implementation, - -- Iir_Kind_Not_Operator - Field_Expr_Staticness, - Field_Operand, - Field_Type, - Field_Implementation, - -- Iir_Kind_Condition_Operator - Field_Expr_Staticness, - Field_Operand, - Field_Type, - Field_Implementation, - -- Iir_Kind_Reduction_And_Operator - Field_Expr_Staticness, - Field_Operand, - Field_Type, - Field_Implementation, - -- Iir_Kind_Reduction_Or_Operator - Field_Expr_Staticness, - Field_Operand, - Field_Type, - Field_Implementation, - -- Iir_Kind_Reduction_Nand_Operator - Field_Expr_Staticness, - Field_Operand, - Field_Type, - Field_Implementation, - -- Iir_Kind_Reduction_Nor_Operator - Field_Expr_Staticness, - Field_Operand, - Field_Type, - Field_Implementation, - -- Iir_Kind_Reduction_Xor_Operator - Field_Expr_Staticness, - Field_Operand, - Field_Type, - Field_Implementation, - -- Iir_Kind_Reduction_Xnor_Operator - Field_Expr_Staticness, - Field_Operand, - Field_Type, - Field_Implementation, - -- Iir_Kind_And_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Or_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Nand_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Nor_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Xor_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Xnor_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Equality_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Inequality_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Less_Than_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Less_Than_Or_Equal_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Greater_Than_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Greater_Than_Or_Equal_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Match_Equality_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Match_Inequality_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Match_Less_Than_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Match_Less_Than_Or_Equal_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Match_Greater_Than_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Match_Greater_Than_Or_Equal_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Sll_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Sla_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Srl_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Sra_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Rol_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Ror_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Addition_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Substraction_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Concatenation_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Multiplication_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Division_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Modulus_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Remainder_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Exponentiation_Operator - Field_Expr_Staticness, - Field_Left, - Field_Right, - Field_Type, - Field_Implementation, - -- Iir_Kind_Function_Call - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Parameter_Association_Chain, - Field_Method_Object, - Field_Type, - Field_Implementation, - Field_Base_Name, - -- Iir_Kind_Aggregate - Field_Expr_Staticness, - Field_Value_Staticness, - Field_Aggregate_Info, - Field_Association_Choices_Chain, - Field_Literal_Subtype, - Field_Type, - -- Iir_Kind_Parenthesis_Expression - Field_Expr_Staticness, - Field_Expression, - Field_Type, - -- Iir_Kind_Qualified_Expression - Field_Expr_Staticness, - Field_Type_Mark, - Field_Expression, - Field_Type, - -- Iir_Kind_Type_Conversion - Field_Expr_Staticness, - Field_Type_Conversion_Subtype, - Field_Type_Mark, - Field_Expression, - Field_Type, - -- Iir_Kind_Allocator_By_Expression - Field_Expr_Staticness, - Field_Expression, - Field_Type, - Field_Allocator_Designated_Type, - -- Iir_Kind_Allocator_By_Subtype - Field_Expr_Staticness, - Field_Subtype_Indication, - Field_Type, - Field_Allocator_Designated_Type, - -- Iir_Kind_Selected_Element - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Type, - Field_Selected_Element, - Field_Base_Name, - -- Iir_Kind_Dereference - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Implicit_Dereference - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Slice_Name - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Suffix, - Field_Slice_Subtype, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Indexed_Name - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Index_List, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Psl_Expression - Field_Psl_Expression, - Field_Type, - -- Iir_Kind_Sensitized_Process_Statement - Field_Label, - Field_Seen_Flag, - Field_End_Has_Postponed, - Field_Passive_Flag, - Field_Postponed_Flag, - Field_Visible_Flag, - Field_Is_Within_Flag, - Field_Has_Is, - Field_End_Has_Reserved_Id, - Field_End_Has_Identifier, - Field_Wait_State, - Field_Declaration_Chain, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Sequential_Statement_Chain, - Field_Sensitivity_List, - Field_Process_Origin, - Field_Parent, - Field_Callees_List, - -- Iir_Kind_Process_Statement - Field_Label, - Field_Seen_Flag, - Field_End_Has_Postponed, - Field_Passive_Flag, - Field_Postponed_Flag, - Field_Visible_Flag, - Field_Is_Within_Flag, - Field_Has_Is, - Field_End_Has_Reserved_Id, - Field_End_Has_Identifier, - Field_Wait_State, - Field_Declaration_Chain, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Sequential_Statement_Chain, - Field_Process_Origin, - Field_Parent, - Field_Callees_List, - -- Iir_Kind_Concurrent_Conditional_Signal_Assignment - Field_Delay_Mechanism, - Field_Label, - Field_Postponed_Flag, - Field_Visible_Flag, - Field_Guarded_Target_State, - Field_Target, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Reject_Time_Expression, - Field_Conditional_Waveform_Chain, - Field_Guard, - Field_Parent, - -- Iir_Kind_Concurrent_Selected_Signal_Assignment - Field_Delay_Mechanism, - Field_Label, - Field_Postponed_Flag, - Field_Visible_Flag, - Field_Guarded_Target_State, - Field_Target, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Expression, - Field_Reject_Time_Expression, - Field_Selected_Waveform_Chain, - Field_Guard, - Field_Parent, - -- Iir_Kind_Concurrent_Assertion_Statement - Field_Label, - Field_Postponed_Flag, - Field_Visible_Flag, - Field_Assertion_Condition, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Severity_Expression, - Field_Report_Expression, - Field_Parent, - -- Iir_Kind_Psl_Default_Clock - Field_Psl_Boolean, - Field_Label, - Field_Chain, - Field_Parent, - -- Iir_Kind_Psl_Assert_Statement - Field_Psl_Property, - Field_Label, - Field_PSL_Clock, - Field_PSL_NFA, - Field_Visible_Flag, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Severity_Expression, - Field_Report_Expression, - Field_Parent, - -- Iir_Kind_Psl_Cover_Statement - Field_Psl_Property, - Field_Label, - Field_PSL_Clock, - Field_PSL_NFA, - Field_Visible_Flag, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Severity_Expression, - Field_Report_Expression, - Field_Parent, - -- Iir_Kind_Concurrent_Procedure_Call_Statement - Field_Label, - Field_Postponed_Flag, - Field_Visible_Flag, - Field_Procedure_Call, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Parent, - -- Iir_Kind_Block_Statement - Field_Label, - Field_Visible_Flag, - Field_Is_Within_Flag, - Field_End_Has_Reserved_Id, - Field_End_Has_Identifier, - Field_Declaration_Chain, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Concurrent_Statement_Chain, - Field_Block_Block_Configuration, - Field_Block_Header, - Field_Guard_Decl, - Field_Parent, - -- Iir_Kind_Generate_Statement - Field_Label, - Field_Has_Begin, - Field_Visible_Flag, - Field_End_Has_Reserved_Id, - Field_End_Has_Identifier, - Field_Declaration_Chain, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Concurrent_Statement_Chain, - Field_Generation_Scheme, - Field_Generate_Block_Configuration, - Field_Parent, - -- Iir_Kind_Component_Instantiation_Statement - Field_Label, - Field_Visible_Flag, - Field_Instantiated_Unit, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Default_Binding_Indication, - Field_Component_Configuration, - Field_Configuration_Specification, - Field_Generic_Map_Aspect_Chain, - Field_Port_Map_Aspect_Chain, - Field_Parent, - -- Iir_Kind_Simple_Simultaneous_Statement - Field_Label, - Field_Visible_Flag, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Simultaneous_Left, - Field_Simultaneous_Right, - Field_Tolerance, - Field_Parent, - -- Iir_Kind_Signal_Assignment_Statement - Field_Delay_Mechanism, - Field_Label, - Field_Visible_Flag, - Field_Guarded_Target_State, - Field_Target, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Waveform_Chain, - Field_Reject_Time_Expression, - Field_Parent, - -- Iir_Kind_Null_Statement - Field_Label, - Field_Visible_Flag, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Parent, - -- Iir_Kind_Assertion_Statement - Field_Label, - Field_Visible_Flag, - Field_Assertion_Condition, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Severity_Expression, - Field_Report_Expression, - Field_Parent, - -- Iir_Kind_Report_Statement - Field_Label, - Field_Visible_Flag, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Severity_Expression, - Field_Report_Expression, - Field_Parent, - -- Iir_Kind_Wait_Statement - Field_Label, - Field_Visible_Flag, - Field_Timeout_Clause, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Condition_Clause, - Field_Sensitivity_List, - Field_Parent, - -- Iir_Kind_Variable_Assignment_Statement - Field_Label, - Field_Visible_Flag, - Field_Target, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Expression, - Field_Parent, - -- Iir_Kind_Return_Statement - Field_Label, - Field_Visible_Flag, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Expression, - Field_Parent, - Field_Type, - -- Iir_Kind_For_Loop_Statement - Field_Label, - Field_Visible_Flag, - Field_Is_Within_Flag, - Field_End_Has_Identifier, - Field_Parameter_Specification, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Sequential_Statement_Chain, - Field_Parent, - -- Iir_Kind_While_Loop_Statement - Field_Label, - Field_Visible_Flag, - Field_End_Has_Identifier, - Field_Condition, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Sequential_Statement_Chain, - Field_Parent, - -- Iir_Kind_Next_Statement - Field_Label, - Field_Visible_Flag, - Field_Condition, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Loop_Label, - Field_Parent, - -- Iir_Kind_Exit_Statement - Field_Label, - Field_Visible_Flag, - Field_Condition, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Loop_Label, - Field_Parent, - -- Iir_Kind_Case_Statement - Field_Label, - Field_Visible_Flag, - Field_End_Has_Identifier, - Field_Case_Statement_Alternative_Chain, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Expression, - Field_Parent, - -- Iir_Kind_Procedure_Call_Statement - Field_Label, - Field_Visible_Flag, - Field_Procedure_Call, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Parent, - -- Iir_Kind_If_Statement - Field_Label, - Field_Visible_Flag, - Field_End_Has_Identifier, - Field_Condition, - Field_Chain, - Field_Attribute_Value_Chain, - Field_Sequential_Statement_Chain, - Field_Else_Clause, - Field_Parent, - -- Iir_Kind_Elsif - Field_End_Has_Identifier, - Field_Condition, - Field_Sequential_Statement_Chain, - Field_Else_Clause, - Field_Parent, - -- Iir_Kind_Character_Literal - Field_Identifier, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Alias_Declaration, - Field_Type, - Field_Named_Entity, - Field_Base_Name, - -- Iir_Kind_Simple_Name - Field_Identifier, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Alias_Declaration, - Field_Type, - Field_Named_Entity, - Field_Base_Name, - -- Iir_Kind_Selected_Name - Field_Identifier, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Alias_Declaration, - Field_Type, - Field_Named_Entity, - Field_Base_Name, - -- Iir_Kind_Operator_Symbol - Field_Identifier, - Field_Alias_Declaration, - Field_Type, - Field_Named_Entity, - Field_Base_Name, - -- Iir_Kind_Selected_By_All_Name - Field_Expr_Staticness, - Field_Prefix, - Field_Type, - Field_Named_Entity, - Field_Base_Name, - -- Iir_Kind_Parenthesis_Name - Field_Prefix, - Field_Association_Chain, - Field_Type, - Field_Named_Entity, - -- Iir_Kind_Base_Attribute - Field_Prefix, - Field_Type, - -- Iir_Kind_Left_Type_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Right_Type_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Type, - Field_Base_Name, - -- Iir_Kind_High_Type_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Low_Type_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Ascending_Type_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Image_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Parameter, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Value_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Parameter, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Pos_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Parameter, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Val_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Parameter, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Succ_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Parameter, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Pred_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Parameter, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Leftof_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Parameter, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Rightof_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Parameter, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Delayed_Attribute - Field_Has_Active_Flag, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Chain, - Field_Parameter, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Stable_Attribute - Field_Has_Active_Flag, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Chain, - Field_Parameter, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Quiet_Attribute - Field_Has_Active_Flag, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Chain, - Field_Parameter, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Transaction_Attribute - Field_Has_Active_Flag, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Chain, - Field_Parameter, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Event_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Type, - -- Iir_Kind_Active_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Type, - -- Iir_Kind_Last_Event_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Type, - -- Iir_Kind_Last_Active_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Type, - -- Iir_Kind_Last_Value_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Type, - -- Iir_Kind_Driving_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Type, - -- Iir_Kind_Driving_Value_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Type, - -- Iir_Kind_Behavior_Attribute - -- Iir_Kind_Structure_Attribute - -- Iir_Kind_Simple_Name_Attribute - Field_Simple_Name_Identifier, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Simple_Name_Subtype, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Instance_Name_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Path_Name_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Left_Array_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Index_Subtype, - Field_Parameter, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Right_Array_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Index_Subtype, - Field_Parameter, - Field_Type, - Field_Base_Name, - -- Iir_Kind_High_Array_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Index_Subtype, - Field_Parameter, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Low_Array_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Index_Subtype, - Field_Parameter, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Length_Array_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Index_Subtype, - Field_Parameter, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Ascending_Array_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Index_Subtype, - Field_Parameter, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Range_Array_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Index_Subtype, - Field_Parameter, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Reverse_Range_Array_Attribute - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Index_Subtype, - Field_Parameter, - Field_Type, - Field_Base_Name, - -- Iir_Kind_Attribute_Name - Field_Identifier, - Field_Expr_Staticness, - Field_Name_Staticness, - Field_Prefix, - Field_Attribute_Signature, - Field_Type, - Field_Named_Entity, - Field_Base_Name - ); - - Fields_Of_Iir_Last : constant array (Iir_Kind) of Integer := - ( - Iir_Kind_Unused => -1, - Iir_Kind_Error => 7, - Iir_Kind_Design_File => 17, - Iir_Kind_Design_Unit => 32, - Iir_Kind_Library_Clause => 37, - Iir_Kind_Use_Clause => 41, - Iir_Kind_Integer_Literal => 45, - Iir_Kind_Floating_Point_Literal => 49, - Iir_Kind_Null_Literal => 51, - Iir_Kind_String_Literal => 57, - Iir_Kind_Physical_Int_Literal => 62, - Iir_Kind_Physical_Fp_Literal => 67, - Iir_Kind_Bit_String_Literal => 76, - Iir_Kind_Simple_Aggregate => 81, - Iir_Kind_Overflow_Literal => 84, - Iir_Kind_Waveform_Element => 87, - Iir_Kind_Conditional_Waveform => 90, - Iir_Kind_Association_Element_By_Expression => 97, - Iir_Kind_Association_Element_By_Individual => 103, - Iir_Kind_Association_Element_Open => 108, - Iir_Kind_Association_Element_Package => 114, - Iir_Kind_Choice_By_Others => 119, - Iir_Kind_Choice_By_Expression => 126, - Iir_Kind_Choice_By_Range => 133, - Iir_Kind_Choice_By_None => 138, - Iir_Kind_Choice_By_Name => 144, - Iir_Kind_Entity_Aspect_Entity => 146, - Iir_Kind_Entity_Aspect_Configuration => 147, - Iir_Kind_Entity_Aspect_Open => 147, - Iir_Kind_Block_Configuration => 153, - Iir_Kind_Block_Header => 157, - Iir_Kind_Component_Configuration => 163, - Iir_Kind_Binding_Indication => 169, - Iir_Kind_Entity_Class => 171, - Iir_Kind_Attribute_Value => 179, - Iir_Kind_Signature => 182, - Iir_Kind_Aggregate_Info => 189, - Iir_Kind_Procedure_Call => 193, - Iir_Kind_Record_Element_Constraint => 199, - Iir_Kind_Array_Element_Resolution => 200, - Iir_Kind_Record_Resolution => 201, - Iir_Kind_Record_Element_Resolution => 204, - Iir_Kind_Attribute_Specification => 212, - Iir_Kind_Disconnection_Specification => 217, - Iir_Kind_Configuration_Specification => 222, - Iir_Kind_Access_Type_Definition => 229, - Iir_Kind_Incomplete_Type_Definition => 236, - Iir_Kind_File_Type_Definition => 243, - Iir_Kind_Protected_Type_Declaration => 252, - Iir_Kind_Record_Type_Definition => 262, - Iir_Kind_Array_Type_Definition => 274, - Iir_Kind_Array_Subtype_Definition => 289, - Iir_Kind_Record_Subtype_Definition => 300, - Iir_Kind_Access_Subtype_Definition => 308, - Iir_Kind_Physical_Subtype_Definition => 317, - Iir_Kind_Floating_Subtype_Definition => 327, - Iir_Kind_Integer_Subtype_Definition => 336, - Iir_Kind_Enumeration_Subtype_Definition => 345, - Iir_Kind_Enumeration_Type_Definition => 354, - Iir_Kind_Integer_Type_Definition => 360, - Iir_Kind_Floating_Type_Definition => 366, - Iir_Kind_Physical_Type_Definition => 375, - Iir_Kind_Range_Expression => 381, - Iir_Kind_Protected_Type_Body => 388, - Iir_Kind_Subtype_Definition => 392, - Iir_Kind_Scalar_Nature_Definition => 396, - Iir_Kind_Overload_List => 397, - Iir_Kind_Type_Declaration => 404, - Iir_Kind_Anonymous_Type_Declaration => 409, - Iir_Kind_Subtype_Declaration => 418, - Iir_Kind_Nature_Declaration => 425, - Iir_Kind_Subnature_Declaration => 432, - Iir_Kind_Package_Declaration => 442, - Iir_Kind_Package_Instantiation_Declaration => 453, - Iir_Kind_Package_Body => 459, - Iir_Kind_Configuration_Declaration => 468, - Iir_Kind_Entity_Declaration => 480, - Iir_Kind_Architecture_Body => 492, - Iir_Kind_Package_Header => 494, - Iir_Kind_Unit_Declaration => 504, - Iir_Kind_Library_Declaration => 510, - Iir_Kind_Component_Declaration => 521, - Iir_Kind_Attribute_Declaration => 528, - Iir_Kind_Group_Template_Declaration => 534, - Iir_Kind_Group_Declaration => 542, - Iir_Kind_Element_Declaration => 549, - Iir_Kind_Non_Object_Alias_Declaration => 557, - Iir_Kind_Psl_Declaration => 565, - Iir_Kind_Terminal_Declaration => 571, - Iir_Kind_Free_Quantity_Declaration => 581, - Iir_Kind_Across_Quantity_Declaration => 594, - Iir_Kind_Through_Quantity_Declaration => 607, - Iir_Kind_Enumeration_Literal => 620, - Iir_Kind_Function_Declaration => 643, - Iir_Kind_Implicit_Function_Declaration => 661, - Iir_Kind_Implicit_Procedure_Declaration => 677, - Iir_Kind_Procedure_Declaration => 698, - Iir_Kind_Function_Body => 707, - Iir_Kind_Procedure_Body => 716, - Iir_Kind_Object_Alias_Declaration => 728, - Iir_Kind_File_Declaration => 744, - Iir_Kind_Guard_Signal_Declaration => 757, - Iir_Kind_Signal_Declaration => 775, - Iir_Kind_Variable_Declaration => 789, - Iir_Kind_Constant_Declaration => 804, - Iir_Kind_Iterator_Declaration => 817, - Iir_Kind_Interface_Constant_Declaration => 832, - Iir_Kind_Interface_Variable_Declaration => 847, - Iir_Kind_Interface_Signal_Declaration => 866, - Iir_Kind_Interface_File_Declaration => 881, - Iir_Kind_Interface_Package_Declaration => 890, - Iir_Kind_Identity_Operator => 894, - Iir_Kind_Negation_Operator => 898, - Iir_Kind_Absolute_Operator => 902, - Iir_Kind_Not_Operator => 906, - Iir_Kind_Condition_Operator => 910, - Iir_Kind_Reduction_And_Operator => 914, - Iir_Kind_Reduction_Or_Operator => 918, - Iir_Kind_Reduction_Nand_Operator => 922, - Iir_Kind_Reduction_Nor_Operator => 926, - Iir_Kind_Reduction_Xor_Operator => 930, - Iir_Kind_Reduction_Xnor_Operator => 934, - Iir_Kind_And_Operator => 939, - Iir_Kind_Or_Operator => 944, - Iir_Kind_Nand_Operator => 949, - Iir_Kind_Nor_Operator => 954, - Iir_Kind_Xor_Operator => 959, - Iir_Kind_Xnor_Operator => 964, - Iir_Kind_Equality_Operator => 969, - Iir_Kind_Inequality_Operator => 974, - Iir_Kind_Less_Than_Operator => 979, - Iir_Kind_Less_Than_Or_Equal_Operator => 984, - Iir_Kind_Greater_Than_Operator => 989, - Iir_Kind_Greater_Than_Or_Equal_Operator => 994, - Iir_Kind_Match_Equality_Operator => 999, - Iir_Kind_Match_Inequality_Operator => 1004, - Iir_Kind_Match_Less_Than_Operator => 1009, - Iir_Kind_Match_Less_Than_Or_Equal_Operator => 1014, - Iir_Kind_Match_Greater_Than_Operator => 1019, - Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 1024, - Iir_Kind_Sll_Operator => 1029, - Iir_Kind_Sla_Operator => 1034, - Iir_Kind_Srl_Operator => 1039, - Iir_Kind_Sra_Operator => 1044, - Iir_Kind_Rol_Operator => 1049, - Iir_Kind_Ror_Operator => 1054, - Iir_Kind_Addition_Operator => 1059, - Iir_Kind_Substraction_Operator => 1064, - Iir_Kind_Concatenation_Operator => 1069, - Iir_Kind_Multiplication_Operator => 1074, - Iir_Kind_Division_Operator => 1079, - Iir_Kind_Modulus_Operator => 1084, - Iir_Kind_Remainder_Operator => 1089, - Iir_Kind_Exponentiation_Operator => 1094, - Iir_Kind_Function_Call => 1102, - Iir_Kind_Aggregate => 1108, - Iir_Kind_Parenthesis_Expression => 1111, - Iir_Kind_Qualified_Expression => 1115, - Iir_Kind_Type_Conversion => 1120, - Iir_Kind_Allocator_By_Expression => 1124, - Iir_Kind_Allocator_By_Subtype => 1128, - Iir_Kind_Selected_Element => 1134, - Iir_Kind_Dereference => 1139, - Iir_Kind_Implicit_Dereference => 1144, - Iir_Kind_Slice_Name => 1151, - Iir_Kind_Indexed_Name => 1157, - Iir_Kind_Psl_Expression => 1159, - Iir_Kind_Sensitized_Process_Statement => 1178, - Iir_Kind_Process_Statement => 1196, - Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1208, - Iir_Kind_Concurrent_Selected_Signal_Assignment => 1221, - Iir_Kind_Concurrent_Assertion_Statement => 1230, - Iir_Kind_Psl_Default_Clock => 1234, - Iir_Kind_Psl_Assert_Statement => 1244, - Iir_Kind_Psl_Cover_Statement => 1254, - Iir_Kind_Concurrent_Procedure_Call_Statement => 1261, - Iir_Kind_Block_Statement => 1274, - Iir_Kind_Generate_Statement => 1286, - Iir_Kind_Component_Instantiation_Statement => 1297, - Iir_Kind_Simple_Simultaneous_Statement => 1305, - Iir_Kind_Signal_Assignment_Statement => 1315, - Iir_Kind_Null_Statement => 1320, - Iir_Kind_Assertion_Statement => 1328, - Iir_Kind_Report_Statement => 1335, - Iir_Kind_Wait_Statement => 1343, - Iir_Kind_Variable_Assignment_Statement => 1350, - Iir_Kind_Return_Statement => 1357, - Iir_Kind_For_Loop_Statement => 1366, - Iir_Kind_While_Loop_Statement => 1374, - Iir_Kind_Next_Statement => 1381, - Iir_Kind_Exit_Statement => 1388, - Iir_Kind_Case_Statement => 1396, - Iir_Kind_Procedure_Call_Statement => 1402, - Iir_Kind_If_Statement => 1411, - Iir_Kind_Elsif => 1416, - Iir_Kind_Character_Literal => 1423, - Iir_Kind_Simple_Name => 1430, - Iir_Kind_Selected_Name => 1438, - Iir_Kind_Operator_Symbol => 1443, - Iir_Kind_Selected_By_All_Name => 1448, - Iir_Kind_Parenthesis_Name => 1452, - Iir_Kind_Base_Attribute => 1454, - Iir_Kind_Left_Type_Attribute => 1459, - Iir_Kind_Right_Type_Attribute => 1464, - Iir_Kind_High_Type_Attribute => 1469, - Iir_Kind_Low_Type_Attribute => 1474, - Iir_Kind_Ascending_Type_Attribute => 1479, - Iir_Kind_Image_Attribute => 1485, - Iir_Kind_Value_Attribute => 1491, - Iir_Kind_Pos_Attribute => 1497, - Iir_Kind_Val_Attribute => 1503, - Iir_Kind_Succ_Attribute => 1509, - Iir_Kind_Pred_Attribute => 1515, - Iir_Kind_Leftof_Attribute => 1521, - Iir_Kind_Rightof_Attribute => 1527, - Iir_Kind_Delayed_Attribute => 1535, - Iir_Kind_Stable_Attribute => 1543, - Iir_Kind_Quiet_Attribute => 1551, - Iir_Kind_Transaction_Attribute => 1559, - Iir_Kind_Event_Attribute => 1563, - Iir_Kind_Active_Attribute => 1567, - Iir_Kind_Last_Event_Attribute => 1571, - Iir_Kind_Last_Active_Attribute => 1575, - Iir_Kind_Last_Value_Attribute => 1579, - Iir_Kind_Driving_Attribute => 1583, - Iir_Kind_Driving_Value_Attribute => 1587, - Iir_Kind_Behavior_Attribute => 1587, - Iir_Kind_Structure_Attribute => 1587, - Iir_Kind_Simple_Name_Attribute => 1594, - Iir_Kind_Instance_Name_Attribute => 1599, - Iir_Kind_Path_Name_Attribute => 1604, - Iir_Kind_Left_Array_Attribute => 1611, - Iir_Kind_Right_Array_Attribute => 1618, - Iir_Kind_High_Array_Attribute => 1625, - Iir_Kind_Low_Array_Attribute => 1632, - Iir_Kind_Length_Array_Attribute => 1639, - Iir_Kind_Ascending_Array_Attribute => 1646, - Iir_Kind_Range_Array_Attribute => 1653, - Iir_Kind_Reverse_Range_Array_Attribute => 1660, - Iir_Kind_Attribute_Name => 1668 - ); - - function Get_Fields (K : Iir_Kind) return Fields_Array - is - First : Natural; - Last : Integer; - begin - if K = Iir_Kind'First then - First := Fields_Of_Iir'First; - else - First := Fields_Of_Iir_Last (Iir_Kind'Pred (K)) + 1; - end if; - Last := Fields_Of_Iir_Last (K); - return Fields_Of_Iir (First .. Last); - end Get_Fields; - - function Get_Base_Type - (N : Iir; F : Fields_Enum) return Base_Type is - begin - pragma Assert (Fields_Type (F) = Type_Base_Type); - case F is - when Field_Bit_String_Base => - return Get_Bit_String_Base (N); - when others => - raise Internal_Error; - end case; - end Get_Base_Type; - - procedure Set_Base_Type - (N : Iir; F : Fields_Enum; V: Base_Type) is - begin - pragma Assert (Fields_Type (F) = Type_Base_Type); - case F is - when Field_Bit_String_Base => - Set_Bit_String_Base (N, V); - when others => - raise Internal_Error; - end case; - end Set_Base_Type; - - function Get_Boolean - (N : Iir; F : Fields_Enum) return Boolean is - begin - pragma Assert (Fields_Type (F) = Type_Boolean); - case F is - when Field_Whole_Association_Flag => - return Get_Whole_Association_Flag (N); - when Field_Collapse_Signal_Flag => - return Get_Collapse_Signal_Flag (N); - when Field_Artificial_Flag => - return Get_Artificial_Flag (N); - when Field_Open_Flag => - return Get_Open_Flag (N); - when Field_After_Drivers_Flag => - return Get_After_Drivers_Flag (N); - when Field_Same_Alternative_Flag => - return Get_Same_Alternative_Flag (N); - when Field_Need_Body => - return Get_Need_Body (N); - when Field_Deferred_Declaration_Flag => - return Get_Deferred_Declaration_Flag (N); - when Field_Shared_Flag => - return Get_Shared_Flag (N); - when Field_Visible_Flag => - return Get_Visible_Flag (N); - when Field_Text_File_Flag => - return Get_Text_File_Flag (N); - when Field_Only_Characters_Flag => - return Get_Only_Characters_Flag (N); - when Field_Postponed_Flag => - return Get_Postponed_Flag (N); - when Field_Passive_Flag => - return Get_Passive_Flag (N); - when Field_Resolution_Function_Flag => - return Get_Resolution_Function_Flag (N); - when Field_Seen_Flag => - return Get_Seen_Flag (N); - when Field_Pure_Flag => - return Get_Pure_Flag (N); - when Field_Foreign_Flag => - return Get_Foreign_Flag (N); - when Field_Resolved_Flag => - return Get_Resolved_Flag (N); - when Field_Signal_Type_Flag => - return Get_Signal_Type_Flag (N); - when Field_Has_Signal_Flag => - return Get_Has_Signal_Flag (N); - when Field_Elab_Flag => - return Get_Elab_Flag (N); - when Field_Index_Constraint_Flag => - return Get_Index_Constraint_Flag (N); - when Field_Aggr_Dynamic_Flag => - return Get_Aggr_Dynamic_Flag (N); - when Field_Aggr_Others_Flag => - return Get_Aggr_Others_Flag (N); - when Field_Aggr_Named_Flag => - return Get_Aggr_Named_Flag (N); - when Field_Has_Disconnect_Flag => - return Get_Has_Disconnect_Flag (N); - when Field_Has_Active_Flag => - return Get_Has_Active_Flag (N); - when Field_Is_Within_Flag => - return Get_Is_Within_Flag (N); - when Field_Implicit_Alias_Flag => - return Get_Implicit_Alias_Flag (N); - when Field_Use_Flag => - return Get_Use_Flag (N); - when Field_End_Has_Reserved_Id => - return Get_End_Has_Reserved_Id (N); - when Field_End_Has_Identifier => - return Get_End_Has_Identifier (N); - when Field_End_Has_Postponed => - return Get_End_Has_Postponed (N); - when Field_Has_Begin => - return Get_Has_Begin (N); - when Field_Has_Is => - return Get_Has_Is (N); - when Field_Has_Pure => - return Get_Has_Pure (N); - when Field_Has_Body => - return Get_Has_Body (N); - when Field_Has_Identifier_List => - return Get_Has_Identifier_List (N); - when Field_Has_Mode => - return Get_Has_Mode (N); - when Field_Is_Ref => - return Get_Is_Ref (N); - when others => - raise Internal_Error; - end case; - end Get_Boolean; - - procedure Set_Boolean - (N : Iir; F : Fields_Enum; V: Boolean) is - begin - pragma Assert (Fields_Type (F) = Type_Boolean); - case F is - when Field_Whole_Association_Flag => - Set_Whole_Association_Flag (N, V); - when Field_Collapse_Signal_Flag => - Set_Collapse_Signal_Flag (N, V); - when Field_Artificial_Flag => - Set_Artificial_Flag (N, V); - when Field_Open_Flag => - Set_Open_Flag (N, V); - when Field_After_Drivers_Flag => - Set_After_Drivers_Flag (N, V); - when Field_Same_Alternative_Flag => - Set_Same_Alternative_Flag (N, V); - when Field_Need_Body => - Set_Need_Body (N, V); - when Field_Deferred_Declaration_Flag => - Set_Deferred_Declaration_Flag (N, V); - when Field_Shared_Flag => - Set_Shared_Flag (N, V); - when Field_Visible_Flag => - Set_Visible_Flag (N, V); - when Field_Text_File_Flag => - Set_Text_File_Flag (N, V); - when Field_Only_Characters_Flag => - Set_Only_Characters_Flag (N, V); - when Field_Postponed_Flag => - Set_Postponed_Flag (N, V); - when Field_Passive_Flag => - Set_Passive_Flag (N, V); - when Field_Resolution_Function_Flag => - Set_Resolution_Function_Flag (N, V); - when Field_Seen_Flag => - Set_Seen_Flag (N, V); - when Field_Pure_Flag => - Set_Pure_Flag (N, V); - when Field_Foreign_Flag => - Set_Foreign_Flag (N, V); - when Field_Resolved_Flag => - Set_Resolved_Flag (N, V); - when Field_Signal_Type_Flag => - Set_Signal_Type_Flag (N, V); - when Field_Has_Signal_Flag => - Set_Has_Signal_Flag (N, V); - when Field_Elab_Flag => - Set_Elab_Flag (N, V); - when Field_Index_Constraint_Flag => - Set_Index_Constraint_Flag (N, V); - when Field_Aggr_Dynamic_Flag => - Set_Aggr_Dynamic_Flag (N, V); - when Field_Aggr_Others_Flag => - Set_Aggr_Others_Flag (N, V); - when Field_Aggr_Named_Flag => - Set_Aggr_Named_Flag (N, V); - when Field_Has_Disconnect_Flag => - Set_Has_Disconnect_Flag (N, V); - when Field_Has_Active_Flag => - Set_Has_Active_Flag (N, V); - when Field_Is_Within_Flag => - Set_Is_Within_Flag (N, V); - when Field_Implicit_Alias_Flag => - Set_Implicit_Alias_Flag (N, V); - when Field_Use_Flag => - Set_Use_Flag (N, V); - when Field_End_Has_Reserved_Id => - Set_End_Has_Reserved_Id (N, V); - when Field_End_Has_Identifier => - Set_End_Has_Identifier (N, V); - when Field_End_Has_Postponed => - Set_End_Has_Postponed (N, V); - when Field_Has_Begin => - Set_Has_Begin (N, V); - when Field_Has_Is => - Set_Has_Is (N, V); - when Field_Has_Pure => - Set_Has_Pure (N, V); - when Field_Has_Body => - Set_Has_Body (N, V); - when Field_Has_Identifier_List => - Set_Has_Identifier_List (N, V); - when Field_Has_Mode => - Set_Has_Mode (N, V); - when Field_Is_Ref => - Set_Is_Ref (N, V); - when others => - raise Internal_Error; - end case; - end Set_Boolean; - - function Get_Date_State_Type - (N : Iir; F : Fields_Enum) return Date_State_Type is - begin - pragma Assert (Fields_Type (F) = Type_Date_State_Type); - case F is - when Field_Date_State => - return Get_Date_State (N); - when others => - raise Internal_Error; - end case; - end Get_Date_State_Type; - - procedure Set_Date_State_Type - (N : Iir; F : Fields_Enum; V: Date_State_Type) is - begin - pragma Assert (Fields_Type (F) = Type_Date_State_Type); - case F is - when Field_Date_State => - Set_Date_State (N, V); - when others => - raise Internal_Error; - end case; - end Set_Date_State_Type; - - function Get_Date_Type - (N : Iir; F : Fields_Enum) return Date_Type is - begin - pragma Assert (Fields_Type (F) = Type_Date_Type); - case F is - when Field_Date => - return Get_Date (N); - when others => - raise Internal_Error; - end case; - end Get_Date_Type; - - procedure Set_Date_Type - (N : Iir; F : Fields_Enum; V: Date_Type) is - begin - pragma Assert (Fields_Type (F) = Type_Date_Type); - case F is - when Field_Date => - Set_Date (N, V); - when others => - raise Internal_Error; - end case; - end Set_Date_Type; - - function Get_Iir - (N : Iir; F : Fields_Enum) return Iir is - begin - pragma Assert (Fields_Type (F) = Type_Iir); - case F is - when Field_First_Design_Unit => - return Get_First_Design_Unit (N); - when Field_Last_Design_Unit => - return Get_Last_Design_Unit (N); - when Field_Library_Declaration => - return Get_Library_Declaration (N); - when Field_Library => - return Get_Library (N); - when Field_Design_File => - return Get_Design_File (N); - when Field_Design_File_Chain => - return Get_Design_File_Chain (N); - when Field_Context_Items => - return Get_Context_Items (N); - when Field_Library_Unit => - return Get_Library_Unit (N); - when Field_Hash_Chain => - return Get_Hash_Chain (N); - when Field_Physical_Literal => - return Get_Physical_Literal (N); - when Field_Physical_Unit_Value => - return Get_Physical_Unit_Value (N); - when Field_Enumeration_Decl => - return Get_Enumeration_Decl (N); - when Field_Bit_String_0 => - return Get_Bit_String_0 (N); - when Field_Bit_String_1 => - return Get_Bit_String_1 (N); - when Field_Literal_Origin => - return Get_Literal_Origin (N); - when Field_Range_Origin => - return Get_Range_Origin (N); - when Field_Literal_Subtype => - return Get_Literal_Subtype (N); - when Field_Attribute_Designator => - return Get_Attribute_Designator (N); - when Field_Attribute_Specification_Chain => - return Get_Attribute_Specification_Chain (N); - when Field_Attribute_Specification => - return Get_Attribute_Specification (N); - when Field_Designated_Entity => - return Get_Designated_Entity (N); - when Field_Formal => - return Get_Formal (N); - when Field_Actual => - return Get_Actual (N); - when Field_In_Conversion => - return Get_In_Conversion (N); - when Field_Out_Conversion => - return Get_Out_Conversion (N); - when Field_We_Value => - return Get_We_Value (N); - when Field_Time => - return Get_Time (N); - when Field_Associated_Expr => - return Get_Associated_Expr (N); - when Field_Associated_Chain => - return Get_Associated_Chain (N); - when Field_Choice_Name => - return Get_Choice_Name (N); - when Field_Choice_Expression => - return Get_Choice_Expression (N); - when Field_Choice_Range => - return Get_Choice_Range (N); - when Field_Architecture => - return Get_Architecture (N); - when Field_Block_Specification => - return Get_Block_Specification (N); - when Field_Prev_Block_Configuration => - return Get_Prev_Block_Configuration (N); - when Field_Configuration_Item_Chain => - return Get_Configuration_Item_Chain (N); - when Field_Attribute_Value_Chain => - return Get_Attribute_Value_Chain (N); - when Field_Spec_Chain => - return Get_Spec_Chain (N); - when Field_Attribute_Value_Spec_Chain => - return Get_Attribute_Value_Spec_Chain (N); - when Field_Entity_Name => - return Get_Entity_Name (N); - when Field_Package => - return Get_Package (N); - when Field_Package_Body => - return Get_Package_Body (N); - when Field_Block_Configuration => - return Get_Block_Configuration (N); - when Field_Concurrent_Statement_Chain => - return Get_Concurrent_Statement_Chain (N); - when Field_Chain => - return Get_Chain (N); - when Field_Port_Chain => - return Get_Port_Chain (N); - when Field_Generic_Chain => - return Get_Generic_Chain (N); - when Field_Type => - return Get_Type (N); - when Field_Subtype_Indication => - return Get_Subtype_Indication (N); - when Field_Discrete_Range => - return Get_Discrete_Range (N); - when Field_Type_Definition => - return Get_Type_Definition (N); - when Field_Subtype_Definition => - return Get_Subtype_Definition (N); - when Field_Nature => - return Get_Nature (N); - when Field_Base_Name => - return Get_Base_Name (N); - when Field_Interface_Declaration_Chain => - return Get_Interface_Declaration_Chain (N); - when Field_Subprogram_Specification => - return Get_Subprogram_Specification (N); - when Field_Sequential_Statement_Chain => - return Get_Sequential_Statement_Chain (N); - when Field_Subprogram_Body => - return Get_Subprogram_Body (N); - when Field_Return_Type => - return Get_Return_Type (N); - when Field_Type_Reference => - return Get_Type_Reference (N); - when Field_Default_Value => - return Get_Default_Value (N); - when Field_Deferred_Declaration => - return Get_Deferred_Declaration (N); - when Field_Design_Unit => - return Get_Design_Unit (N); - when Field_Block_Statement => - return Get_Block_Statement (N); - when Field_Signal_Driver => - return Get_Signal_Driver (N); - when Field_Declaration_Chain => - return Get_Declaration_Chain (N); - when Field_File_Logical_Name => - return Get_File_Logical_Name (N); - when Field_File_Open_Kind => - return Get_File_Open_Kind (N); - when Field_Element_Declaration => - return Get_Element_Declaration (N); - when Field_Selected_Element => - return Get_Selected_Element (N); - when Field_Use_Clause_Chain => - return Get_Use_Clause_Chain (N); - when Field_Selected_Name => - return Get_Selected_Name (N); - when Field_Type_Declarator => - return Get_Type_Declarator (N); - when Field_Entity_Class_Entry_Chain => - return Get_Entity_Class_Entry_Chain (N); - when Field_Unit_Chain => - return Get_Unit_Chain (N); - when Field_Primary_Unit => - return Get_Primary_Unit (N); - when Field_Range_Constraint => - return Get_Range_Constraint (N); - when Field_Left_Limit => - return Get_Left_Limit (N); - when Field_Right_Limit => - return Get_Right_Limit (N); - when Field_Base_Type => - return Get_Base_Type (N); - when Field_Resolution_Indication => - return Get_Resolution_Indication (N); - when Field_Record_Element_Resolution_Chain => - return Get_Record_Element_Resolution_Chain (N); - when Field_Tolerance => - return Get_Tolerance (N); - when Field_Plus_Terminal => - return Get_Plus_Terminal (N); - when Field_Minus_Terminal => - return Get_Minus_Terminal (N); - when Field_Simultaneous_Left => - return Get_Simultaneous_Left (N); - when Field_Simultaneous_Right => - return Get_Simultaneous_Right (N); - when Field_Element_Subtype_Indication => - return Get_Element_Subtype_Indication (N); - when Field_Element_Subtype => - return Get_Element_Subtype (N); - when Field_Array_Element_Constraint => - return Get_Array_Element_Constraint (N); - when Field_Designated_Type => - return Get_Designated_Type (N); - when Field_Designated_Subtype_Indication => - return Get_Designated_Subtype_Indication (N); - when Field_Reference => - return Get_Reference (N); - when Field_Nature_Declarator => - return Get_Nature_Declarator (N); - when Field_Across_Type => - return Get_Across_Type (N); - when Field_Through_Type => - return Get_Through_Type (N); - when Field_Target => - return Get_Target (N); - when Field_Waveform_Chain => - return Get_Waveform_Chain (N); - when Field_Guard => - return Get_Guard (N); - when Field_Reject_Time_Expression => - return Get_Reject_Time_Expression (N); - when Field_Process_Origin => - return Get_Process_Origin (N); - when Field_Condition_Clause => - return Get_Condition_Clause (N); - when Field_Timeout_Clause => - return Get_Timeout_Clause (N); - when Field_Assertion_Condition => - return Get_Assertion_Condition (N); - when Field_Report_Expression => - return Get_Report_Expression (N); - when Field_Severity_Expression => - return Get_Severity_Expression (N); - when Field_Instantiated_Unit => - return Get_Instantiated_Unit (N); - when Field_Generic_Map_Aspect_Chain => - return Get_Generic_Map_Aspect_Chain (N); - when Field_Port_Map_Aspect_Chain => - return Get_Port_Map_Aspect_Chain (N); - when Field_Configuration_Name => - return Get_Configuration_Name (N); - when Field_Component_Configuration => - return Get_Component_Configuration (N); - when Field_Configuration_Specification => - return Get_Configuration_Specification (N); - when Field_Default_Binding_Indication => - return Get_Default_Binding_Indication (N); - when Field_Default_Configuration_Declaration => - return Get_Default_Configuration_Declaration (N); - when Field_Expression => - return Get_Expression (N); - when Field_Allocator_Designated_Type => - return Get_Allocator_Designated_Type (N); - when Field_Selected_Waveform_Chain => - return Get_Selected_Waveform_Chain (N); - when Field_Conditional_Waveform_Chain => - return Get_Conditional_Waveform_Chain (N); - when Field_Guard_Expression => - return Get_Guard_Expression (N); - when Field_Guard_Decl => - return Get_Guard_Decl (N); - when Field_Block_Block_Configuration => - return Get_Block_Block_Configuration (N); - when Field_Package_Header => - return Get_Package_Header (N); - when Field_Block_Header => - return Get_Block_Header (N); - when Field_Uninstantiated_Package_Name => - return Get_Uninstantiated_Package_Name (N); - when Field_Generate_Block_Configuration => - return Get_Generate_Block_Configuration (N); - when Field_Generation_Scheme => - return Get_Generation_Scheme (N); - when Field_Condition => - return Get_Condition (N); - when Field_Else_Clause => - return Get_Else_Clause (N); - when Field_Parameter_Specification => - return Get_Parameter_Specification (N); - when Field_Parent => - return Get_Parent (N); - when Field_Loop_Label => - return Get_Loop_Label (N); - when Field_Component_Name => - return Get_Component_Name (N); - when Field_Entity_Aspect => - return Get_Entity_Aspect (N); - when Field_Default_Entity_Aspect => - return Get_Default_Entity_Aspect (N); - when Field_Default_Generic_Map_Aspect_Chain => - return Get_Default_Generic_Map_Aspect_Chain (N); - when Field_Default_Port_Map_Aspect_Chain => - return Get_Default_Port_Map_Aspect_Chain (N); - when Field_Binding_Indication => - return Get_Binding_Indication (N); - when Field_Named_Entity => - return Get_Named_Entity (N); - when Field_Alias_Declaration => - return Get_Alias_Declaration (N); - when Field_Error_Origin => - return Get_Error_Origin (N); - when Field_Operand => - return Get_Operand (N); - when Field_Left => - return Get_Left (N); - when Field_Right => - return Get_Right (N); - when Field_Unit_Name => - return Get_Unit_Name (N); - when Field_Name => - return Get_Name (N); - when Field_Group_Template_Name => - return Get_Group_Template_Name (N); - when Field_Prefix => - return Get_Prefix (N); - when Field_Signature_Prefix => - return Get_Signature_Prefix (N); - when Field_Slice_Subtype => - return Get_Slice_Subtype (N); - when Field_Suffix => - return Get_Suffix (N); - when Field_Index_Subtype => - return Get_Index_Subtype (N); - when Field_Parameter => - return Get_Parameter (N); - when Field_Actual_Type => - return Get_Actual_Type (N); - when Field_Associated_Interface => - return Get_Associated_Interface (N); - when Field_Association_Chain => - return Get_Association_Chain (N); - when Field_Individual_Association_Chain => - return Get_Individual_Association_Chain (N); - when Field_Aggregate_Info => - return Get_Aggregate_Info (N); - when Field_Sub_Aggregate_Info => - return Get_Sub_Aggregate_Info (N); - when Field_Aggr_Low_Limit => - return Get_Aggr_Low_Limit (N); - when Field_Aggr_High_Limit => - return Get_Aggr_High_Limit (N); - when Field_Association_Choices_Chain => - return Get_Association_Choices_Chain (N); - when Field_Case_Statement_Alternative_Chain => - return Get_Case_Statement_Alternative_Chain (N); - when Field_Procedure_Call => - return Get_Procedure_Call (N); - when Field_Implementation => - return Get_Implementation (N); - when Field_Parameter_Association_Chain => - return Get_Parameter_Association_Chain (N); - when Field_Method_Object => - return Get_Method_Object (N); - when Field_Subtype_Type_Mark => - return Get_Subtype_Type_Mark (N); - when Field_Type_Conversion_Subtype => - return Get_Type_Conversion_Subtype (N); - when Field_Type_Mark => - return Get_Type_Mark (N); - when Field_File_Type_Mark => - return Get_File_Type_Mark (N); - when Field_Return_Type_Mark => - return Get_Return_Type_Mark (N); - when Field_Alias_Signature => - return Get_Alias_Signature (N); - when Field_Attribute_Signature => - return Get_Attribute_Signature (N); - when Field_Simple_Name_Subtype => - return Get_Simple_Name_Subtype (N); - when Field_Protected_Type_Body => - return Get_Protected_Type_Body (N); - when Field_Protected_Type_Declaration => - return Get_Protected_Type_Declaration (N); - when others => - raise Internal_Error; - end case; - end Get_Iir; - - procedure Set_Iir - (N : Iir; F : Fields_Enum; V: Iir) is - begin - pragma Assert (Fields_Type (F) = Type_Iir); - case F is - when Field_First_Design_Unit => - Set_First_Design_Unit (N, V); - when Field_Last_Design_Unit => - Set_Last_Design_Unit (N, V); - when Field_Library_Declaration => - Set_Library_Declaration (N, V); - when Field_Library => - Set_Library (N, V); - when Field_Design_File => - Set_Design_File (N, V); - when Field_Design_File_Chain => - Set_Design_File_Chain (N, V); - when Field_Context_Items => - Set_Context_Items (N, V); - when Field_Library_Unit => - Set_Library_Unit (N, V); - when Field_Hash_Chain => - Set_Hash_Chain (N, V); - when Field_Physical_Literal => - Set_Physical_Literal (N, V); - when Field_Physical_Unit_Value => - Set_Physical_Unit_Value (N, V); - when Field_Enumeration_Decl => - Set_Enumeration_Decl (N, V); - when Field_Bit_String_0 => - Set_Bit_String_0 (N, V); - when Field_Bit_String_1 => - Set_Bit_String_1 (N, V); - when Field_Literal_Origin => - Set_Literal_Origin (N, V); - when Field_Range_Origin => - Set_Range_Origin (N, V); - when Field_Literal_Subtype => - Set_Literal_Subtype (N, V); - when Field_Attribute_Designator => - Set_Attribute_Designator (N, V); - when Field_Attribute_Specification_Chain => - Set_Attribute_Specification_Chain (N, V); - when Field_Attribute_Specification => - Set_Attribute_Specification (N, V); - when Field_Designated_Entity => - Set_Designated_Entity (N, V); - when Field_Formal => - Set_Formal (N, V); - when Field_Actual => - Set_Actual (N, V); - when Field_In_Conversion => - Set_In_Conversion (N, V); - when Field_Out_Conversion => - Set_Out_Conversion (N, V); - when Field_We_Value => - Set_We_Value (N, V); - when Field_Time => - Set_Time (N, V); - when Field_Associated_Expr => - Set_Associated_Expr (N, V); - when Field_Associated_Chain => - Set_Associated_Chain (N, V); - when Field_Choice_Name => - Set_Choice_Name (N, V); - when Field_Choice_Expression => - Set_Choice_Expression (N, V); - when Field_Choice_Range => - Set_Choice_Range (N, V); - when Field_Architecture => - Set_Architecture (N, V); - when Field_Block_Specification => - Set_Block_Specification (N, V); - when Field_Prev_Block_Configuration => - Set_Prev_Block_Configuration (N, V); - when Field_Configuration_Item_Chain => - Set_Configuration_Item_Chain (N, V); - when Field_Attribute_Value_Chain => - Set_Attribute_Value_Chain (N, V); - when Field_Spec_Chain => - Set_Spec_Chain (N, V); - when Field_Attribute_Value_Spec_Chain => - Set_Attribute_Value_Spec_Chain (N, V); - when Field_Entity_Name => - Set_Entity_Name (N, V); - when Field_Package => - Set_Package (N, V); - when Field_Package_Body => - Set_Package_Body (N, V); - when Field_Block_Configuration => - Set_Block_Configuration (N, V); - when Field_Concurrent_Statement_Chain => - Set_Concurrent_Statement_Chain (N, V); - when Field_Chain => - Set_Chain (N, V); - when Field_Port_Chain => - Set_Port_Chain (N, V); - when Field_Generic_Chain => - Set_Generic_Chain (N, V); - when Field_Type => - Set_Type (N, V); - when Field_Subtype_Indication => - Set_Subtype_Indication (N, V); - when Field_Discrete_Range => - Set_Discrete_Range (N, V); - when Field_Type_Definition => - Set_Type_Definition (N, V); - when Field_Subtype_Definition => - Set_Subtype_Definition (N, V); - when Field_Nature => - Set_Nature (N, V); - when Field_Base_Name => - Set_Base_Name (N, V); - when Field_Interface_Declaration_Chain => - Set_Interface_Declaration_Chain (N, V); - when Field_Subprogram_Specification => - Set_Subprogram_Specification (N, V); - when Field_Sequential_Statement_Chain => - Set_Sequential_Statement_Chain (N, V); - when Field_Subprogram_Body => - Set_Subprogram_Body (N, V); - when Field_Return_Type => - Set_Return_Type (N, V); - when Field_Type_Reference => - Set_Type_Reference (N, V); - when Field_Default_Value => - Set_Default_Value (N, V); - when Field_Deferred_Declaration => - Set_Deferred_Declaration (N, V); - when Field_Design_Unit => - Set_Design_Unit (N, V); - when Field_Block_Statement => - Set_Block_Statement (N, V); - when Field_Signal_Driver => - Set_Signal_Driver (N, V); - when Field_Declaration_Chain => - Set_Declaration_Chain (N, V); - when Field_File_Logical_Name => - Set_File_Logical_Name (N, V); - when Field_File_Open_Kind => - Set_File_Open_Kind (N, V); - when Field_Element_Declaration => - Set_Element_Declaration (N, V); - when Field_Selected_Element => - Set_Selected_Element (N, V); - when Field_Use_Clause_Chain => - Set_Use_Clause_Chain (N, V); - when Field_Selected_Name => - Set_Selected_Name (N, V); - when Field_Type_Declarator => - Set_Type_Declarator (N, V); - when Field_Entity_Class_Entry_Chain => - Set_Entity_Class_Entry_Chain (N, V); - when Field_Unit_Chain => - Set_Unit_Chain (N, V); - when Field_Primary_Unit => - Set_Primary_Unit (N, V); - when Field_Range_Constraint => - Set_Range_Constraint (N, V); - when Field_Left_Limit => - Set_Left_Limit (N, V); - when Field_Right_Limit => - Set_Right_Limit (N, V); - when Field_Base_Type => - Set_Base_Type (N, V); - when Field_Resolution_Indication => - Set_Resolution_Indication (N, V); - when Field_Record_Element_Resolution_Chain => - Set_Record_Element_Resolution_Chain (N, V); - when Field_Tolerance => - Set_Tolerance (N, V); - when Field_Plus_Terminal => - Set_Plus_Terminal (N, V); - when Field_Minus_Terminal => - Set_Minus_Terminal (N, V); - when Field_Simultaneous_Left => - Set_Simultaneous_Left (N, V); - when Field_Simultaneous_Right => - Set_Simultaneous_Right (N, V); - when Field_Element_Subtype_Indication => - Set_Element_Subtype_Indication (N, V); - when Field_Element_Subtype => - Set_Element_Subtype (N, V); - when Field_Array_Element_Constraint => - Set_Array_Element_Constraint (N, V); - when Field_Designated_Type => - Set_Designated_Type (N, V); - when Field_Designated_Subtype_Indication => - Set_Designated_Subtype_Indication (N, V); - when Field_Reference => - Set_Reference (N, V); - when Field_Nature_Declarator => - Set_Nature_Declarator (N, V); - when Field_Across_Type => - Set_Across_Type (N, V); - when Field_Through_Type => - Set_Through_Type (N, V); - when Field_Target => - Set_Target (N, V); - when Field_Waveform_Chain => - Set_Waveform_Chain (N, V); - when Field_Guard => - Set_Guard (N, V); - when Field_Reject_Time_Expression => - Set_Reject_Time_Expression (N, V); - when Field_Process_Origin => - Set_Process_Origin (N, V); - when Field_Condition_Clause => - Set_Condition_Clause (N, V); - when Field_Timeout_Clause => - Set_Timeout_Clause (N, V); - when Field_Assertion_Condition => - Set_Assertion_Condition (N, V); - when Field_Report_Expression => - Set_Report_Expression (N, V); - when Field_Severity_Expression => - Set_Severity_Expression (N, V); - when Field_Instantiated_Unit => - Set_Instantiated_Unit (N, V); - when Field_Generic_Map_Aspect_Chain => - Set_Generic_Map_Aspect_Chain (N, V); - when Field_Port_Map_Aspect_Chain => - Set_Port_Map_Aspect_Chain (N, V); - when Field_Configuration_Name => - Set_Configuration_Name (N, V); - when Field_Component_Configuration => - Set_Component_Configuration (N, V); - when Field_Configuration_Specification => - Set_Configuration_Specification (N, V); - when Field_Default_Binding_Indication => - Set_Default_Binding_Indication (N, V); - when Field_Default_Configuration_Declaration => - Set_Default_Configuration_Declaration (N, V); - when Field_Expression => - Set_Expression (N, V); - when Field_Allocator_Designated_Type => - Set_Allocator_Designated_Type (N, V); - when Field_Selected_Waveform_Chain => - Set_Selected_Waveform_Chain (N, V); - when Field_Conditional_Waveform_Chain => - Set_Conditional_Waveform_Chain (N, V); - when Field_Guard_Expression => - Set_Guard_Expression (N, V); - when Field_Guard_Decl => - Set_Guard_Decl (N, V); - when Field_Block_Block_Configuration => - Set_Block_Block_Configuration (N, V); - when Field_Package_Header => - Set_Package_Header (N, V); - when Field_Block_Header => - Set_Block_Header (N, V); - when Field_Uninstantiated_Package_Name => - Set_Uninstantiated_Package_Name (N, V); - when Field_Generate_Block_Configuration => - Set_Generate_Block_Configuration (N, V); - when Field_Generation_Scheme => - Set_Generation_Scheme (N, V); - when Field_Condition => - Set_Condition (N, V); - when Field_Else_Clause => - Set_Else_Clause (N, V); - when Field_Parameter_Specification => - Set_Parameter_Specification (N, V); - when Field_Parent => - Set_Parent (N, V); - when Field_Loop_Label => - Set_Loop_Label (N, V); - when Field_Component_Name => - Set_Component_Name (N, V); - when Field_Entity_Aspect => - Set_Entity_Aspect (N, V); - when Field_Default_Entity_Aspect => - Set_Default_Entity_Aspect (N, V); - when Field_Default_Generic_Map_Aspect_Chain => - Set_Default_Generic_Map_Aspect_Chain (N, V); - when Field_Default_Port_Map_Aspect_Chain => - Set_Default_Port_Map_Aspect_Chain (N, V); - when Field_Binding_Indication => - Set_Binding_Indication (N, V); - when Field_Named_Entity => - Set_Named_Entity (N, V); - when Field_Alias_Declaration => - Set_Alias_Declaration (N, V); - when Field_Error_Origin => - Set_Error_Origin (N, V); - when Field_Operand => - Set_Operand (N, V); - when Field_Left => - Set_Left (N, V); - when Field_Right => - Set_Right (N, V); - when Field_Unit_Name => - Set_Unit_Name (N, V); - when Field_Name => - Set_Name (N, V); - when Field_Group_Template_Name => - Set_Group_Template_Name (N, V); - when Field_Prefix => - Set_Prefix (N, V); - when Field_Signature_Prefix => - Set_Signature_Prefix (N, V); - when Field_Slice_Subtype => - Set_Slice_Subtype (N, V); - when Field_Suffix => - Set_Suffix (N, V); - when Field_Index_Subtype => - Set_Index_Subtype (N, V); - when Field_Parameter => - Set_Parameter (N, V); - when Field_Actual_Type => - Set_Actual_Type (N, V); - when Field_Associated_Interface => - Set_Associated_Interface (N, V); - when Field_Association_Chain => - Set_Association_Chain (N, V); - when Field_Individual_Association_Chain => - Set_Individual_Association_Chain (N, V); - when Field_Aggregate_Info => - Set_Aggregate_Info (N, V); - when Field_Sub_Aggregate_Info => - Set_Sub_Aggregate_Info (N, V); - when Field_Aggr_Low_Limit => - Set_Aggr_Low_Limit (N, V); - when Field_Aggr_High_Limit => - Set_Aggr_High_Limit (N, V); - when Field_Association_Choices_Chain => - Set_Association_Choices_Chain (N, V); - when Field_Case_Statement_Alternative_Chain => - Set_Case_Statement_Alternative_Chain (N, V); - when Field_Procedure_Call => - Set_Procedure_Call (N, V); - when Field_Implementation => - Set_Implementation (N, V); - when Field_Parameter_Association_Chain => - Set_Parameter_Association_Chain (N, V); - when Field_Method_Object => - Set_Method_Object (N, V); - when Field_Subtype_Type_Mark => - Set_Subtype_Type_Mark (N, V); - when Field_Type_Conversion_Subtype => - Set_Type_Conversion_Subtype (N, V); - when Field_Type_Mark => - Set_Type_Mark (N, V); - when Field_File_Type_Mark => - Set_File_Type_Mark (N, V); - when Field_Return_Type_Mark => - Set_Return_Type_Mark (N, V); - when Field_Alias_Signature => - Set_Alias_Signature (N, V); - when Field_Attribute_Signature => - Set_Attribute_Signature (N, V); - when Field_Simple_Name_Subtype => - Set_Simple_Name_Subtype (N, V); - when Field_Protected_Type_Body => - Set_Protected_Type_Body (N, V); - when Field_Protected_Type_Declaration => - Set_Protected_Type_Declaration (N, V); - when others => - raise Internal_Error; - end case; - end Set_Iir; - - function Get_Iir_All_Sensitized - (N : Iir; F : Fields_Enum) return Iir_All_Sensitized is - begin - pragma Assert (Fields_Type (F) = Type_Iir_All_Sensitized); - case F is - when Field_All_Sensitized_State => - return Get_All_Sensitized_State (N); - when others => - raise Internal_Error; - end case; - end Get_Iir_All_Sensitized; - - procedure Set_Iir_All_Sensitized - (N : Iir; F : Fields_Enum; V: Iir_All_Sensitized) is - begin - pragma Assert (Fields_Type (F) = Type_Iir_All_Sensitized); - case F is - when Field_All_Sensitized_State => - Set_All_Sensitized_State (N, V); - when others => - raise Internal_Error; - end case; - end Set_Iir_All_Sensitized; - - function Get_Iir_Constraint - (N : Iir; F : Fields_Enum) return Iir_Constraint is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Constraint); - case F is - when Field_Constraint_State => - return Get_Constraint_State (N); - when others => - raise Internal_Error; - end case; - end Get_Iir_Constraint; - - procedure Set_Iir_Constraint - (N : Iir; F : Fields_Enum; V: Iir_Constraint) is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Constraint); - case F is - when Field_Constraint_State => - Set_Constraint_State (N, V); - when others => - raise Internal_Error; - end case; - end Set_Iir_Constraint; - - function Get_Iir_Delay_Mechanism - (N : Iir; F : Fields_Enum) return Iir_Delay_Mechanism is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Delay_Mechanism); - case F is - when Field_Delay_Mechanism => - return Get_Delay_Mechanism (N); - when others => - raise Internal_Error; - end case; - end Get_Iir_Delay_Mechanism; - - procedure Set_Iir_Delay_Mechanism - (N : Iir; F : Fields_Enum; V: Iir_Delay_Mechanism) is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Delay_Mechanism); - case F is - when Field_Delay_Mechanism => - Set_Delay_Mechanism (N, V); - when others => - raise Internal_Error; - end case; - end Set_Iir_Delay_Mechanism; - - function Get_Iir_Direction - (N : Iir; F : Fields_Enum) return Iir_Direction is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Direction); - case F is - when Field_Direction => - return Get_Direction (N); - when others => - raise Internal_Error; - end case; - end Get_Iir_Direction; - - procedure Set_Iir_Direction - (N : Iir; F : Fields_Enum; V: Iir_Direction) is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Direction); - case F is - when Field_Direction => - Set_Direction (N, V); - when others => - raise Internal_Error; - end case; - end Set_Iir_Direction; - - function Get_Iir_Fp64 - (N : Iir; F : Fields_Enum) return Iir_Fp64 is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Fp64); - case F is - when Field_Fp_Value => - return Get_Fp_Value (N); - when others => - raise Internal_Error; - end case; - end Get_Iir_Fp64; - - procedure Set_Iir_Fp64 - (N : Iir; F : Fields_Enum; V: Iir_Fp64) is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Fp64); - case F is - when Field_Fp_Value => - Set_Fp_Value (N, V); - when others => - raise Internal_Error; - end case; - end Set_Iir_Fp64; - - function Get_Iir_Index32 - (N : Iir; F : Fields_Enum) return Iir_Index32 is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Index32); - case F is - when Field_Element_Position => - return Get_Element_Position (N); - when others => - raise Internal_Error; - end case; - end Get_Iir_Index32; - - procedure Set_Iir_Index32 - (N : Iir; F : Fields_Enum; V: Iir_Index32) is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Index32); - case F is - when Field_Element_Position => - Set_Element_Position (N, V); - when others => - raise Internal_Error; - end case; - end Set_Iir_Index32; - - function Get_Iir_Int32 - (N : Iir; F : Fields_Enum) return Iir_Int32 is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Int32); - case F is - when Field_Enum_Pos => - return Get_Enum_Pos (N); - when Field_Overload_Number => - return Get_Overload_Number (N); - when Field_Subprogram_Depth => - return Get_Subprogram_Depth (N); - when Field_Subprogram_Hash => - return Get_Subprogram_Hash (N); - when Field_Impure_Depth => - return Get_Impure_Depth (N); - when Field_Aggr_Min_Length => - return Get_Aggr_Min_Length (N); - when others => - raise Internal_Error; - end case; - end Get_Iir_Int32; - - procedure Set_Iir_Int32 - (N : Iir; F : Fields_Enum; V: Iir_Int32) is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Int32); - case F is - when Field_Enum_Pos => - Set_Enum_Pos (N, V); - when Field_Overload_Number => - Set_Overload_Number (N, V); - when Field_Subprogram_Depth => - Set_Subprogram_Depth (N, V); - when Field_Subprogram_Hash => - Set_Subprogram_Hash (N, V); - when Field_Impure_Depth => - Set_Impure_Depth (N, V); - when Field_Aggr_Min_Length => - Set_Aggr_Min_Length (N, V); - when others => - raise Internal_Error; - end case; - end Set_Iir_Int32; - - function Get_Iir_Int64 - (N : Iir; F : Fields_Enum) return Iir_Int64 is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Int64); - case F is - when Field_Value => - return Get_Value (N); - when others => - raise Internal_Error; - end case; - end Get_Iir_Int64; - - procedure Set_Iir_Int64 - (N : Iir; F : Fields_Enum; V: Iir_Int64) is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Int64); - case F is - when Field_Value => - Set_Value (N, V); - when others => - raise Internal_Error; - end case; - end Set_Iir_Int64; - - function Get_Iir_Lexical_Layout_Type - (N : Iir; F : Fields_Enum) return Iir_Lexical_Layout_Type is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Lexical_Layout_Type); - case F is - when Field_Lexical_Layout => - return Get_Lexical_Layout (N); - when others => - raise Internal_Error; - end case; - end Get_Iir_Lexical_Layout_Type; - - procedure Set_Iir_Lexical_Layout_Type - (N : Iir; F : Fields_Enum; V: Iir_Lexical_Layout_Type) is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Lexical_Layout_Type); - case F is - when Field_Lexical_Layout => - Set_Lexical_Layout (N, V); - when others => - raise Internal_Error; - end case; - end Set_Iir_Lexical_Layout_Type; - - function Get_Iir_List - (N : Iir; F : Fields_Enum) return Iir_List is - begin - pragma Assert (Fields_Type (F) = Type_Iir_List); - case F is - when Field_File_Dependence_List => - return Get_File_Dependence_List (N); - when Field_Dependence_List => - return Get_Dependence_List (N); - when Field_Analysis_Checks_List => - return Get_Analysis_Checks_List (N); - when Field_Simple_Aggregate_List => - return Get_Simple_Aggregate_List (N); - when Field_Entity_Name_List => - return Get_Entity_Name_List (N); - when Field_Signal_List => - return Get_Signal_List (N); - when Field_Enumeration_Literal_List => - return Get_Enumeration_Literal_List (N); - when Field_Group_Constituent_List => - return Get_Group_Constituent_List (N); - when Field_Index_Subtype_List => - return Get_Index_Subtype_List (N); - when Field_Index_Subtype_Definition_List => - return Get_Index_Subtype_Definition_List (N); - when Field_Index_Constraint_List => - return Get_Index_Constraint_List (N); - when Field_Elements_Declaration_List => - return Get_Elements_Declaration_List (N); - when Field_Index_List => - return Get_Index_List (N); - when Field_Sensitivity_List => - return Get_Sensitivity_List (N); - when Field_Callees_List => - return Get_Callees_List (N); - when Field_Guard_Sensitivity_List => - return Get_Guard_Sensitivity_List (N); - when Field_Instantiation_List => - return Get_Instantiation_List (N); - when Field_Incomplete_Type_List => - return Get_Incomplete_Type_List (N); - when Field_Type_Marks_List => - return Get_Type_Marks_List (N); - when Field_Overload_List => - return Get_Overload_List (N); - when others => - raise Internal_Error; - end case; - end Get_Iir_List; - - procedure Set_Iir_List - (N : Iir; F : Fields_Enum; V: Iir_List) is - begin - pragma Assert (Fields_Type (F) = Type_Iir_List); - case F is - when Field_File_Dependence_List => - Set_File_Dependence_List (N, V); - when Field_Dependence_List => - Set_Dependence_List (N, V); - when Field_Analysis_Checks_List => - Set_Analysis_Checks_List (N, V); - when Field_Simple_Aggregate_List => - Set_Simple_Aggregate_List (N, V); - when Field_Entity_Name_List => - Set_Entity_Name_List (N, V); - when Field_Signal_List => - Set_Signal_List (N, V); - when Field_Enumeration_Literal_List => - Set_Enumeration_Literal_List (N, V); - when Field_Group_Constituent_List => - Set_Group_Constituent_List (N, V); - when Field_Index_Subtype_List => - Set_Index_Subtype_List (N, V); - when Field_Index_Subtype_Definition_List => - Set_Index_Subtype_Definition_List (N, V); - when Field_Index_Constraint_List => - Set_Index_Constraint_List (N, V); - when Field_Elements_Declaration_List => - Set_Elements_Declaration_List (N, V); - when Field_Index_List => - Set_Index_List (N, V); - when Field_Sensitivity_List => - Set_Sensitivity_List (N, V); - when Field_Callees_List => - Set_Callees_List (N, V); - when Field_Guard_Sensitivity_List => - Set_Guard_Sensitivity_List (N, V); - when Field_Instantiation_List => - Set_Instantiation_List (N, V); - when Field_Incomplete_Type_List => - Set_Incomplete_Type_List (N, V); - when Field_Type_Marks_List => - Set_Type_Marks_List (N, V); - when Field_Overload_List => - Set_Overload_List (N, V); - when others => - raise Internal_Error; - end case; - end Set_Iir_List; - - function Get_Iir_Mode - (N : Iir; F : Fields_Enum) return Iir_Mode is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Mode); - case F is - when Field_Mode => - return Get_Mode (N); - when others => - raise Internal_Error; - end case; - end Get_Iir_Mode; - - procedure Set_Iir_Mode - (N : Iir; F : Fields_Enum; V: Iir_Mode) is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Mode); - case F is - when Field_Mode => - Set_Mode (N, V); - when others => - raise Internal_Error; - end case; - end Set_Iir_Mode; - - function Get_Iir_Predefined_Functions - (N : Iir; F : Fields_Enum) return Iir_Predefined_Functions is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Predefined_Functions); - case F is - when Field_Implicit_Definition => - return Get_Implicit_Definition (N); - when others => - raise Internal_Error; - end case; - end Get_Iir_Predefined_Functions; - - procedure Set_Iir_Predefined_Functions - (N : Iir; F : Fields_Enum; V: Iir_Predefined_Functions) is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Predefined_Functions); - case F is - when Field_Implicit_Definition => - Set_Implicit_Definition (N, V); - when others => - raise Internal_Error; - end case; - end Set_Iir_Predefined_Functions; - - function Get_Iir_Pure_State - (N : Iir; F : Fields_Enum) return Iir_Pure_State is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Pure_State); - case F is - when Field_Purity_State => - return Get_Purity_State (N); - when others => - raise Internal_Error; - end case; - end Get_Iir_Pure_State; - - procedure Set_Iir_Pure_State - (N : Iir; F : Fields_Enum; V: Iir_Pure_State) is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Pure_State); - case F is - when Field_Purity_State => - Set_Purity_State (N, V); - when others => - raise Internal_Error; - end case; - end Set_Iir_Pure_State; - - function Get_Iir_Signal_Kind - (N : Iir; F : Fields_Enum) return Iir_Signal_Kind is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Signal_Kind); - case F is - when Field_Signal_Kind => - return Get_Signal_Kind (N); - when others => - raise Internal_Error; - end case; - end Get_Iir_Signal_Kind; - - procedure Set_Iir_Signal_Kind - (N : Iir; F : Fields_Enum; V: Iir_Signal_Kind) is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Signal_Kind); - case F is - when Field_Signal_Kind => - Set_Signal_Kind (N, V); - when others => - raise Internal_Error; - end case; - end Set_Iir_Signal_Kind; - - function Get_Iir_Staticness - (N : Iir; F : Fields_Enum) return Iir_Staticness is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Staticness); - case F is - when Field_Type_Staticness => - return Get_Type_Staticness (N); - when Field_Expr_Staticness => - return Get_Expr_Staticness (N); - when Field_Name_Staticness => - return Get_Name_Staticness (N); - when Field_Value_Staticness => - return Get_Value_Staticness (N); - when Field_Choice_Staticness => - return Get_Choice_Staticness (N); - when others => - raise Internal_Error; - end case; - end Get_Iir_Staticness; - - procedure Set_Iir_Staticness - (N : Iir; F : Fields_Enum; V: Iir_Staticness) is - begin - pragma Assert (Fields_Type (F) = Type_Iir_Staticness); - case F is - when Field_Type_Staticness => - Set_Type_Staticness (N, V); - when Field_Expr_Staticness => - Set_Expr_Staticness (N, V); - when Field_Name_Staticness => - Set_Name_Staticness (N, V); - when Field_Value_Staticness => - Set_Value_Staticness (N, V); - when Field_Choice_Staticness => - Set_Choice_Staticness (N, V); - when others => - raise Internal_Error; - end case; - end Set_Iir_Staticness; - - function Get_Int32 - (N : Iir; F : Fields_Enum) return Int32 is - begin - pragma Assert (Fields_Type (F) = Type_Int32); - case F is - when Field_Design_Unit_Source_Line => - return Get_Design_Unit_Source_Line (N); - when Field_Design_Unit_Source_Col => - return Get_Design_Unit_Source_Col (N); - when Field_String_Length => - return Get_String_Length (N); - when others => - raise Internal_Error; - end case; - end Get_Int32; - - procedure Set_Int32 - (N : Iir; F : Fields_Enum; V: Int32) is - begin - pragma Assert (Fields_Type (F) = Type_Int32); - case F is - when Field_Design_Unit_Source_Line => - Set_Design_Unit_Source_Line (N, V); - when Field_Design_Unit_Source_Col => - Set_Design_Unit_Source_Col (N, V); - when Field_String_Length => - Set_String_Length (N, V); - when others => - raise Internal_Error; - end case; - end Set_Int32; - - function Get_Location_Type - (N : Iir; F : Fields_Enum) return Location_Type is - begin - pragma Assert (Fields_Type (F) = Type_Location_Type); - case F is - when Field_End_Location => - return Get_End_Location (N); - when others => - raise Internal_Error; - end case; - end Get_Location_Type; - - procedure Set_Location_Type - (N : Iir; F : Fields_Enum; V: Location_Type) is - begin - pragma Assert (Fields_Type (F) = Type_Location_Type); - case F is - when Field_End_Location => - Set_End_Location (N, V); - when others => - raise Internal_Error; - end case; - end Set_Location_Type; - - function Get_Name_Id - (N : Iir; F : Fields_Enum) return Name_Id is - begin - pragma Assert (Fields_Type (F) = Type_Name_Id); - case F is - when Field_Design_File_Filename => - return Get_Design_File_Filename (N); - when Field_Design_File_Directory => - return Get_Design_File_Directory (N); - when Field_Library_Directory => - return Get_Library_Directory (N); - when Field_Identifier => - return Get_Identifier (N); - when Field_Label => - return Get_Label (N); - when Field_Simple_Name_Identifier => - return Get_Simple_Name_Identifier (N); - when others => - raise Internal_Error; - end case; - end Get_Name_Id; - - procedure Set_Name_Id - (N : Iir; F : Fields_Enum; V: Name_Id) is - begin - pragma Assert (Fields_Type (F) = Type_Name_Id); - case F is - when Field_Design_File_Filename => - Set_Design_File_Filename (N, V); - when Field_Design_File_Directory => - Set_Design_File_Directory (N, V); - when Field_Library_Directory => - Set_Library_Directory (N, V); - when Field_Identifier => - Set_Identifier (N, V); - when Field_Label => - Set_Label (N, V); - when Field_Simple_Name_Identifier => - Set_Simple_Name_Identifier (N, V); - when others => - raise Internal_Error; - end case; - end Set_Name_Id; - - function Get_PSL_NFA - (N : Iir; F : Fields_Enum) return PSL_NFA is - begin - pragma Assert (Fields_Type (F) = Type_PSL_NFA); - case F is - when Field_PSL_NFA => - return Get_PSL_NFA (N); - when others => - raise Internal_Error; - end case; - end Get_PSL_NFA; - - procedure Set_PSL_NFA - (N : Iir; F : Fields_Enum; V: PSL_NFA) is - begin - pragma Assert (Fields_Type (F) = Type_PSL_NFA); - case F is - when Field_PSL_NFA => - Set_PSL_NFA (N, V); - when others => - raise Internal_Error; - end case; - end Set_PSL_NFA; - - function Get_PSL_Node - (N : Iir; F : Fields_Enum) return PSL_Node is - begin - pragma Assert (Fields_Type (F) = Type_PSL_Node); - case F is - when Field_Psl_Property => - return Get_Psl_Property (N); - when Field_Psl_Declaration => - return Get_Psl_Declaration (N); - when Field_Psl_Expression => - return Get_Psl_Expression (N); - when Field_Psl_Boolean => - return Get_Psl_Boolean (N); - when Field_PSL_Clock => - return Get_PSL_Clock (N); - when others => - raise Internal_Error; - end case; - end Get_PSL_Node; - - procedure Set_PSL_Node - (N : Iir; F : Fields_Enum; V: PSL_Node) is - begin - pragma Assert (Fields_Type (F) = Type_PSL_Node); - case F is - when Field_Psl_Property => - Set_Psl_Property (N, V); - when Field_Psl_Declaration => - Set_Psl_Declaration (N, V); - when Field_Psl_Expression => - Set_Psl_Expression (N, V); - when Field_Psl_Boolean => - Set_Psl_Boolean (N, V); - when Field_PSL_Clock => - Set_PSL_Clock (N, V); - when others => - raise Internal_Error; - end case; - end Set_PSL_Node; - - function Get_Source_Ptr - (N : Iir; F : Fields_Enum) return Source_Ptr is - begin - pragma Assert (Fields_Type (F) = Type_Source_Ptr); - case F is - when Field_Design_Unit_Source_Pos => - return Get_Design_Unit_Source_Pos (N); - when others => - raise Internal_Error; - end case; - end Get_Source_Ptr; - - procedure Set_Source_Ptr - (N : Iir; F : Fields_Enum; V: Source_Ptr) is - begin - pragma Assert (Fields_Type (F) = Type_Source_Ptr); - case F is - when Field_Design_Unit_Source_Pos => - Set_Design_Unit_Source_Pos (N, V); - when others => - raise Internal_Error; - end case; - end Set_Source_Ptr; - - function Get_String_Id - (N : Iir; F : Fields_Enum) return String_Id is - begin - pragma Assert (Fields_Type (F) = Type_String_Id); - case F is - when Field_String_Id => - return Get_String_Id (N); - when others => - raise Internal_Error; - end case; - end Get_String_Id; - - procedure Set_String_Id - (N : Iir; F : Fields_Enum; V: String_Id) is - begin - pragma Assert (Fields_Type (F) = Type_String_Id); - case F is - when Field_String_Id => - Set_String_Id (N, V); - when others => - raise Internal_Error; - end case; - end Set_String_Id; - - function Get_Time_Stamp_Id - (N : Iir; F : Fields_Enum) return Time_Stamp_Id is - begin - pragma Assert (Fields_Type (F) = Type_Time_Stamp_Id); - case F is - when Field_File_Time_Stamp => - return Get_File_Time_Stamp (N); - when Field_Analysis_Time_Stamp => - return Get_Analysis_Time_Stamp (N); - when others => - raise Internal_Error; - end case; - end Get_Time_Stamp_Id; - - procedure Set_Time_Stamp_Id - (N : Iir; F : Fields_Enum; V: Time_Stamp_Id) is - begin - pragma Assert (Fields_Type (F) = Type_Time_Stamp_Id); - case F is - when Field_File_Time_Stamp => - Set_File_Time_Stamp (N, V); - when Field_Analysis_Time_Stamp => - Set_Analysis_Time_Stamp (N, V); - when others => - raise Internal_Error; - end case; - end Set_Time_Stamp_Id; - - function Get_Token_Type - (N : Iir; F : Fields_Enum) return Token_Type is - begin - pragma Assert (Fields_Type (F) = Type_Token_Type); - case F is - when Field_Entity_Class => - return Get_Entity_Class (N); - when others => - raise Internal_Error; - end case; - end Get_Token_Type; - - procedure Set_Token_Type - (N : Iir; F : Fields_Enum; V: Token_Type) is - begin - pragma Assert (Fields_Type (F) = Type_Token_Type); - case F is - when Field_Entity_Class => - Set_Entity_Class (N, V); - when others => - raise Internal_Error; - end case; - end Set_Token_Type; - - function Get_Tri_State_Type - (N : Iir; F : Fields_Enum) return Tri_State_Type is - begin - pragma Assert (Fields_Type (F) = Type_Tri_State_Type); - case F is - when Field_Guarded_Target_State => - return Get_Guarded_Target_State (N); - when Field_Wait_State => - return Get_Wait_State (N); - when others => - raise Internal_Error; - end case; - end Get_Tri_State_Type; - - procedure Set_Tri_State_Type - (N : Iir; F : Fields_Enum; V: Tri_State_Type) is - begin - pragma Assert (Fields_Type (F) = Type_Tri_State_Type); - case F is - when Field_Guarded_Target_State => - Set_Guarded_Target_State (N, V); - when Field_Wait_State => - Set_Wait_State (N, V); - when others => - raise Internal_Error; - end case; - end Set_Tri_State_Type; - - function Has_First_Design_Unit (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Design_File; - end Has_First_Design_Unit; - - function Has_Last_Design_Unit (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Design_File; - end Has_Last_Design_Unit; - - function Has_Library_Declaration (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Library_Clause; - end Has_Library_Declaration; - - function Has_File_Time_Stamp (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Design_File; - end Has_File_Time_Stamp; - - function Has_Analysis_Time_Stamp (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Design_File; - end Has_Analysis_Time_Stamp; - - function Has_Library (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Design_File; - end Has_Library; - - function Has_File_Dependence_List (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Design_File; - end Has_File_Dependence_List; - - function Has_Design_File_Filename (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Design_File; - end Has_Design_File_Filename; - - function Has_Design_File_Directory (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Design_File; - end Has_Design_File_Directory; - - function Has_Design_File (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Design_Unit; - end Has_Design_File; - - function Has_Design_File_Chain (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Library_Declaration; - end Has_Design_File_Chain; - - function Has_Library_Directory (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Library_Declaration; - end Has_Library_Directory; - - function Has_Date (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Design_Unit - | Iir_Kind_Library_Declaration => - return True; - when others => - return False; - end case; - end Has_Date; - - function Has_Context_Items (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Design_Unit; - end Has_Context_Items; - - function Has_Dependence_List (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Design_Unit; - end Has_Dependence_List; - - function Has_Analysis_Checks_List (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Design_Unit; - end Has_Analysis_Checks_List; - - function Has_Date_State (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Design_Unit; - end Has_Date_State; - - function Has_Guarded_Target_State (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Signal_Assignment_Statement => - return True; - when others => - return False; - end case; - end Has_Guarded_Target_State; - - function Has_Library_Unit (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Design_Unit; - end Has_Library_Unit; - - function Has_Hash_Chain (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Design_Unit; - end Has_Hash_Chain; - - function Has_Design_Unit_Source_Pos (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Design_Unit; - end Has_Design_Unit_Source_Pos; - - function Has_Design_Unit_Source_Line (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Design_Unit; - end Has_Design_Unit_Source_Line; - - function Has_Design_Unit_Source_Col (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Design_Unit; - end Has_Design_Unit_Source_Col; - - function Has_Value (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Integer_Literal - | Iir_Kind_Physical_Int_Literal => - return True; - when others => - return False; - end case; - end Has_Value; - - function Has_Enum_Pos (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Enumeration_Literal; - end Has_Enum_Pos; - - function Has_Physical_Literal (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Unit_Declaration; - end Has_Physical_Literal; - - function Has_Physical_Unit_Value (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Unit_Declaration; - end Has_Physical_Unit_Value; - - function Has_Fp_Value (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Floating_Point_Literal - | Iir_Kind_Physical_Fp_Literal => - return True; - when others => - return False; - end case; - end Has_Fp_Value; - - function Has_Enumeration_Decl (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Enumeration_Literal; - end Has_Enumeration_Decl; - - function Has_Simple_Aggregate_List (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Simple_Aggregate; - end Has_Simple_Aggregate_List; - - function Has_Bit_String_Base (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Bit_String_Literal; - end Has_Bit_String_Base; - - function Has_Bit_String_0 (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Bit_String_Literal; - end Has_Bit_String_0; - - function Has_Bit_String_1 (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Bit_String_Literal; - end Has_Bit_String_1; - - function Has_Literal_Origin (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Integer_Literal - | Iir_Kind_Floating_Point_Literal - | Iir_Kind_String_Literal - | Iir_Kind_Physical_Int_Literal - | Iir_Kind_Physical_Fp_Literal - | Iir_Kind_Bit_String_Literal - | Iir_Kind_Simple_Aggregate - | Iir_Kind_Overflow_Literal - | Iir_Kind_Enumeration_Literal => - return True; - when others => - return False; - end case; - end Has_Literal_Origin; - - function Has_Range_Origin (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Range_Expression; - end Has_Range_Origin; - - function Has_Literal_Subtype (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal - | Iir_Kind_Simple_Aggregate - | Iir_Kind_Aggregate => - return True; - when others => - return False; - end case; - end Has_Literal_Subtype; - - function Has_Entity_Class (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Entity_Class - | Iir_Kind_Attribute_Specification => - return True; - when others => - return False; - end case; - end Has_Entity_Class; - - function Has_Entity_Name_List (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Attribute_Specification; - end Has_Entity_Name_List; - - function Has_Attribute_Designator (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Attribute_Specification; - end Has_Attribute_Designator; - - function Has_Attribute_Specification_Chain (K : Iir_Kind) - return Boolean is - begin - return K = Iir_Kind_Attribute_Specification; - end Has_Attribute_Specification_Chain; - - function Has_Attribute_Specification (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Attribute_Value; - end Has_Attribute_Specification; - - function Has_Signal_List (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Disconnection_Specification; - end Has_Signal_List; - - function Has_Designated_Entity (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Attribute_Value; - end Has_Designated_Entity; - - function Has_Formal (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Association_Element_By_Expression - | Iir_Kind_Association_Element_By_Individual - | Iir_Kind_Association_Element_Open - | Iir_Kind_Association_Element_Package => - return True; - when others => - return False; - end case; - end Has_Formal; - - function Has_Actual (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Association_Element_By_Expression - | Iir_Kind_Association_Element_Package => - return True; - when others => - return False; - end case; - end Has_Actual; - - function Has_In_Conversion (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Association_Element_By_Expression; - end Has_In_Conversion; - - function Has_Out_Conversion (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Association_Element_By_Expression; - end Has_Out_Conversion; - - function Has_Whole_Association_Flag (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Association_Element_By_Expression - | Iir_Kind_Association_Element_By_Individual - | Iir_Kind_Association_Element_Open - | Iir_Kind_Association_Element_Package => - return True; - when others => - return False; - end case; - end Has_Whole_Association_Flag; - - function Has_Collapse_Signal_Flag (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Association_Element_By_Expression - | Iir_Kind_Association_Element_By_Individual - | Iir_Kind_Association_Element_Open - | Iir_Kind_Association_Element_Package => - return True; - when others => - return False; - end case; - end Has_Collapse_Signal_Flag; - - function Has_Artificial_Flag (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Association_Element_Open; - end Has_Artificial_Flag; - - function Has_Open_Flag (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Interface_Signal_Declaration; - end Has_Open_Flag; - - function Has_After_Drivers_Flag (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Object_Alias_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_File_Declaration => - return True; - when others => - return False; - end case; - end Has_After_Drivers_Flag; - - function Has_We_Value (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Waveform_Element; - end Has_We_Value; - - function Has_Time (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Waveform_Element; - end Has_Time; - - function Has_Associated_Expr (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Choice_By_Others - | Iir_Kind_Choice_By_Expression - | Iir_Kind_Choice_By_Range - | Iir_Kind_Choice_By_None - | Iir_Kind_Choice_By_Name => - return True; - when others => - return False; - end case; - end Has_Associated_Expr; - - function Has_Associated_Chain (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Choice_By_Others - | Iir_Kind_Choice_By_Expression - | Iir_Kind_Choice_By_Range - | Iir_Kind_Choice_By_None - | Iir_Kind_Choice_By_Name => - return True; - when others => - return False; - end case; - end Has_Associated_Chain; - - function Has_Choice_Name (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Choice_By_Name; - end Has_Choice_Name; - - function Has_Choice_Expression (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Choice_By_Expression; - end Has_Choice_Expression; - - function Has_Choice_Range (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Choice_By_Range; - end Has_Choice_Range; - - function Has_Same_Alternative_Flag (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Choice_By_Others - | Iir_Kind_Choice_By_Expression - | Iir_Kind_Choice_By_Range - | Iir_Kind_Choice_By_None - | Iir_Kind_Choice_By_Name => - return True; - when others => - return False; - end case; - end Has_Same_Alternative_Flag; - - function Has_Architecture (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Entity_Aspect_Entity; - end Has_Architecture; - - function Has_Block_Specification (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Block_Configuration; - end Has_Block_Specification; - - function Has_Prev_Block_Configuration (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Block_Configuration; - end Has_Prev_Block_Configuration; - - function Has_Configuration_Item_Chain (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Block_Configuration; - end Has_Configuration_Item_Chain; - - function Has_Attribute_Value_Chain (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Type_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Nature_Declaration - | Iir_Kind_Subnature_Declaration - | Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Unit_Declaration - | Iir_Kind_Component_Declaration - | Iir_Kind_Group_Declaration - | Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Enumeration_Literal - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Interface_Package_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Concurrent_Procedure_Call_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement - | Iir_Kind_Component_Instantiation_Statement - | Iir_Kind_Simple_Simultaneous_Statement - | Iir_Kind_Signal_Assignment_Statement - | Iir_Kind_Null_Statement - | Iir_Kind_Assertion_Statement - | Iir_Kind_Report_Statement - | Iir_Kind_Wait_Statement - | Iir_Kind_Variable_Assignment_Statement - | Iir_Kind_Return_Statement - | Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement - | Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement - | Iir_Kind_Case_Statement - | Iir_Kind_Procedure_Call_Statement - | Iir_Kind_If_Statement => - return True; - when others => - return False; - end case; - end Has_Attribute_Value_Chain; - - function Has_Spec_Chain (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Attribute_Value; - end Has_Spec_Chain; - - function Has_Attribute_Value_Spec_Chain (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Attribute_Specification; - end Has_Attribute_Value_Spec_Chain; - - function Has_Entity_Name (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Entity_Aspect_Entity - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Architecture_Body => - return True; - when others => - return False; - end case; - end Has_Entity_Name; - - function Has_Package (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Package_Body; - end Has_Package; - - function Has_Package_Body (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration => - return True; - when others => - return False; - end case; - end Has_Package_Body; - - function Has_Need_Body (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Package_Declaration; - end Has_Need_Body; - - function Has_Block_Configuration (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Component_Configuration - | Iir_Kind_Configuration_Declaration => - return True; - when others => - return False; - end case; - end Has_Block_Configuration; - - function Has_Concurrent_Statement_Chain (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement => - return True; - when others => - return False; - end case; - end Has_Concurrent_Statement_Chain; - - function Has_Chain (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Design_File - | Iir_Kind_Design_Unit - | Iir_Kind_Library_Clause - | Iir_Kind_Use_Clause - | Iir_Kind_Waveform_Element - | Iir_Kind_Conditional_Waveform - | Iir_Kind_Association_Element_By_Expression - | Iir_Kind_Association_Element_By_Individual - | Iir_Kind_Association_Element_Open - | Iir_Kind_Association_Element_Package - | Iir_Kind_Choice_By_Others - | Iir_Kind_Choice_By_Expression - | Iir_Kind_Choice_By_Range - | Iir_Kind_Choice_By_None - | Iir_Kind_Choice_By_Name - | Iir_Kind_Block_Configuration - | Iir_Kind_Component_Configuration - | Iir_Kind_Entity_Class - | Iir_Kind_Attribute_Value - | Iir_Kind_Record_Element_Resolution - | Iir_Kind_Attribute_Specification - | Iir_Kind_Disconnection_Specification - | Iir_Kind_Configuration_Specification - | Iir_Kind_Protected_Type_Body - | Iir_Kind_Type_Declaration - | Iir_Kind_Anonymous_Type_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Nature_Declaration - | Iir_Kind_Subnature_Declaration - | Iir_Kind_Unit_Declaration - | Iir_Kind_Library_Declaration - | Iir_Kind_Component_Declaration - | Iir_Kind_Attribute_Declaration - | Iir_Kind_Group_Template_Declaration - | Iir_Kind_Group_Declaration - | Iir_Kind_Non_Object_Alias_Declaration - | Iir_Kind_Psl_Declaration - | Iir_Kind_Terminal_Declaration - | Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Interface_Package_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Psl_Default_Clock - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Concurrent_Procedure_Call_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement - | Iir_Kind_Component_Instantiation_Statement - | Iir_Kind_Simple_Simultaneous_Statement - | Iir_Kind_Signal_Assignment_Statement - | Iir_Kind_Null_Statement - | Iir_Kind_Assertion_Statement - | Iir_Kind_Report_Statement - | Iir_Kind_Wait_Statement - | Iir_Kind_Variable_Assignment_Statement - | Iir_Kind_Return_Statement - | Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement - | Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement - | Iir_Kind_Case_Statement - | Iir_Kind_Procedure_Call_Statement - | Iir_Kind_If_Statement - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute => - return True; - when others => - return False; - end case; - end Has_Chain; - - function Has_Port_Chain (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Block_Header - | Iir_Kind_Entity_Declaration - | Iir_Kind_Component_Declaration => - return True; - when others => - return False; - end case; - end Has_Port_Chain; - - function Has_Generic_Chain (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Block_Header - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Package_Header - | Iir_Kind_Component_Declaration - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Interface_Package_Declaration => - return True; - when others => - return False; - end case; - end Has_Generic_Chain; - - function Has_Type (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Error - | Iir_Kind_Integer_Literal - | Iir_Kind_Floating_Point_Literal - | Iir_Kind_Null_Literal - | Iir_Kind_String_Literal - | Iir_Kind_Physical_Int_Literal - | Iir_Kind_Physical_Fp_Literal - | Iir_Kind_Bit_String_Literal - | Iir_Kind_Simple_Aggregate - | Iir_Kind_Overflow_Literal - | Iir_Kind_Attribute_Value - | Iir_Kind_Record_Element_Constraint - | Iir_Kind_Range_Expression - | Iir_Kind_Type_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Unit_Declaration - | Iir_Kind_Attribute_Declaration - | Iir_Kind_Element_Declaration - | Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Enumeration_Literal - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Identity_Operator - | Iir_Kind_Negation_Operator - | Iir_Kind_Absolute_Operator - | Iir_Kind_Not_Operator - | Iir_Kind_Condition_Operator - | Iir_Kind_Reduction_And_Operator - | Iir_Kind_Reduction_Or_Operator - | Iir_Kind_Reduction_Nand_Operator - | Iir_Kind_Reduction_Nor_Operator - | Iir_Kind_Reduction_Xor_Operator - | Iir_Kind_Reduction_Xnor_Operator - | Iir_Kind_And_Operator - | Iir_Kind_Or_Operator - | Iir_Kind_Nand_Operator - | Iir_Kind_Nor_Operator - | Iir_Kind_Xor_Operator - | Iir_Kind_Xnor_Operator - | Iir_Kind_Equality_Operator - | Iir_Kind_Inequality_Operator - | Iir_Kind_Less_Than_Operator - | Iir_Kind_Less_Than_Or_Equal_Operator - | Iir_Kind_Greater_Than_Operator - | Iir_Kind_Greater_Than_Or_Equal_Operator - | Iir_Kind_Match_Equality_Operator - | Iir_Kind_Match_Inequality_Operator - | Iir_Kind_Match_Less_Than_Operator - | Iir_Kind_Match_Less_Than_Or_Equal_Operator - | Iir_Kind_Match_Greater_Than_Operator - | Iir_Kind_Match_Greater_Than_Or_Equal_Operator - | Iir_Kind_Sll_Operator - | Iir_Kind_Sla_Operator - | Iir_Kind_Srl_Operator - | Iir_Kind_Sra_Operator - | Iir_Kind_Rol_Operator - | Iir_Kind_Ror_Operator - | Iir_Kind_Addition_Operator - | Iir_Kind_Substraction_Operator - | Iir_Kind_Concatenation_Operator - | Iir_Kind_Multiplication_Operator - | Iir_Kind_Division_Operator - | Iir_Kind_Modulus_Operator - | Iir_Kind_Remainder_Operator - | Iir_Kind_Exponentiation_Operator - | Iir_Kind_Function_Call - | Iir_Kind_Aggregate - | Iir_Kind_Parenthesis_Expression - | Iir_Kind_Qualified_Expression - | Iir_Kind_Type_Conversion - | Iir_Kind_Allocator_By_Expression - | Iir_Kind_Allocator_By_Subtype - | Iir_Kind_Selected_Element - | Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference - | Iir_Kind_Slice_Name - | Iir_Kind_Indexed_Name - | Iir_Kind_Psl_Expression - | Iir_Kind_Return_Statement - | Iir_Kind_Character_Literal - | Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Operator_Symbol - | Iir_Kind_Selected_By_All_Name - | Iir_Kind_Parenthesis_Name - | Iir_Kind_Base_Attribute - | Iir_Kind_Left_Type_Attribute - | Iir_Kind_Right_Type_Attribute - | Iir_Kind_High_Type_Attribute - | Iir_Kind_Low_Type_Attribute - | Iir_Kind_Ascending_Type_Attribute - | Iir_Kind_Image_Attribute - | Iir_Kind_Value_Attribute - | Iir_Kind_Pos_Attribute - | Iir_Kind_Val_Attribute - | Iir_Kind_Succ_Attribute - | Iir_Kind_Pred_Attribute - | Iir_Kind_Leftof_Attribute - | Iir_Kind_Rightof_Attribute - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute - | Iir_Kind_Event_Attribute - | Iir_Kind_Active_Attribute - | Iir_Kind_Last_Event_Attribute - | Iir_Kind_Last_Active_Attribute - | Iir_Kind_Last_Value_Attribute - | Iir_Kind_Driving_Attribute - | Iir_Kind_Driving_Value_Attribute - | Iir_Kind_Simple_Name_Attribute - | Iir_Kind_Instance_Name_Attribute - | Iir_Kind_Path_Name_Attribute - | Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute - | Iir_Kind_Attribute_Name => - return True; - when others => - return False; - end case; - end Has_Type; - - function Has_Subtype_Indication (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Subtype_Declaration - | Iir_Kind_Element_Declaration - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Allocator_By_Subtype => - return True; - when others => - return False; - end case; - end Has_Subtype_Indication; - - function Has_Discrete_Range (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Iterator_Declaration; - end Has_Discrete_Range; - - function Has_Type_Definition (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Type_Declaration - | Iir_Kind_Anonymous_Type_Declaration => - return True; - when others => - return False; - end case; - end Has_Type_Definition; - - function Has_Subtype_Definition (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Anonymous_Type_Declaration; - end Has_Subtype_Definition; - - function Has_Nature (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Nature_Declaration - | Iir_Kind_Subnature_Declaration - | Iir_Kind_Terminal_Declaration => - return True; - when others => - return False; - end case; - end Has_Nature; - - function Has_Mode (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_File_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_File_Declaration => - return True; - when others => - return False; - end case; - end Has_Mode; - - function Has_Signal_Kind (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Interface_Signal_Declaration => - return True; - when others => - return False; - end case; - end Has_Signal_Kind; - - function Has_Base_Name (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Attribute_Value - | Iir_Kind_Function_Call - | Iir_Kind_Selected_Element - | Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference - | Iir_Kind_Slice_Name - | Iir_Kind_Indexed_Name - | Iir_Kind_Character_Literal - | Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Operator_Symbol - | Iir_Kind_Selected_By_All_Name - | Iir_Kind_Left_Type_Attribute - | Iir_Kind_Right_Type_Attribute - | Iir_Kind_High_Type_Attribute - | Iir_Kind_Low_Type_Attribute - | Iir_Kind_Ascending_Type_Attribute - | Iir_Kind_Image_Attribute - | Iir_Kind_Value_Attribute - | Iir_Kind_Pos_Attribute - | Iir_Kind_Val_Attribute - | Iir_Kind_Succ_Attribute - | Iir_Kind_Pred_Attribute - | Iir_Kind_Leftof_Attribute - | Iir_Kind_Rightof_Attribute - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute - | Iir_Kind_Simple_Name_Attribute - | Iir_Kind_Instance_Name_Attribute - | Iir_Kind_Path_Name_Attribute - | Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute - | Iir_Kind_Attribute_Name => - return True; - when others => - return False; - end case; - end Has_Base_Name; - - function Has_Interface_Declaration_Chain (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration => - return True; - when others => - return False; - end case; - end Has_Interface_Declaration_Chain; - - function Has_Subprogram_Specification (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body => - return True; - when others => - return False; - end case; - end Has_Subprogram_Specification; - - function Has_Sequential_Statement_Chain (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement - | Iir_Kind_If_Statement - | Iir_Kind_Elsif => - return True; - when others => - return False; - end case; - end Has_Sequential_Statement_Chain; - - function Has_Subprogram_Body (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => - return True; - when others => - return False; - end case; - end Has_Subprogram_Body; - - function Has_Overload_Number (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration => - return True; - when others => - return False; - end case; - end Has_Overload_Number; - - function Has_Subprogram_Depth (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => - return True; - when others => - return False; - end case; - end Has_Subprogram_Depth; - - function Has_Subprogram_Hash (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Enumeration_Literal - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration => - return True; - when others => - return False; - end case; - end Has_Subprogram_Hash; - - function Has_Impure_Depth (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body => - return True; - when others => - return False; - end case; - end Has_Impure_Depth; - - function Has_Return_Type (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Enumeration_Literal - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration => - return True; - when others => - return False; - end case; - end Has_Return_Type; - - function Has_Implicit_Definition (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - return True; - when others => - return False; - end case; - end Has_Implicit_Definition; - - function Has_Type_Reference (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - return True; - when others => - return False; - end case; - end Has_Type_Reference; - - function Has_Default_Value (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_File_Declaration => - return True; - when others => - return False; - end case; - end Has_Default_Value; - - function Has_Deferred_Declaration (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Constant_Declaration; - end Has_Deferred_Declaration; - - function Has_Deferred_Declaration_Flag (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Constant_Declaration; - end Has_Deferred_Declaration_Flag; - - function Has_Shared_Flag (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Variable_Declaration; - end Has_Shared_Flag; - - function Has_Design_Unit (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body => - return True; - when others => - return False; - end case; - end Has_Design_Unit; - - function Has_Block_Statement (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Guard_Signal_Declaration; - end Has_Block_Statement; - - function Has_Signal_Driver (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Signal_Declaration; - end Has_Signal_Driver; - - function Has_Declaration_Chain (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Block_Configuration - | Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Protected_Type_Body - | Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Interface_Package_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement => - return True; - when others => - return False; - end case; - end Has_Declaration_Chain; - - function Has_File_Logical_Name (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_File_Declaration; - end Has_File_Logical_Name; - - function Has_File_Open_Kind (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_File_Declaration; - end Has_File_Open_Kind; - - function Has_Element_Position (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Record_Element_Constraint - | Iir_Kind_Element_Declaration => - return True; - when others => - return False; - end case; - end Has_Element_Position; - - function Has_Element_Declaration (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Record_Element_Constraint; - end Has_Element_Declaration; - - function Has_Selected_Element (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Selected_Element; - end Has_Selected_Element; - - function Has_Use_Clause_Chain (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Use_Clause; - end Has_Use_Clause_Chain; - - function Has_Selected_Name (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Use_Clause; - end Has_Selected_Name; - - function Has_Type_Declarator (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Error - | Iir_Kind_Access_Type_Definition - | Iir_Kind_Incomplete_Type_Definition - | Iir_Kind_File_Type_Definition - | Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Record_Type_Definition - | Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Access_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Integer_Type_Definition - | Iir_Kind_Floating_Type_Definition - | Iir_Kind_Physical_Type_Definition => - return True; - when others => - return False; - end case; - end Has_Type_Declarator; - - function Has_Enumeration_Literal_List (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Enumeration_Type_Definition; - end Has_Enumeration_Literal_List; - - function Has_Entity_Class_Entry_Chain (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Group_Template_Declaration; - end Has_Entity_Class_Entry_Chain; - - function Has_Group_Constituent_List (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Group_Declaration; - end Has_Group_Constituent_List; - - function Has_Unit_Chain (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Physical_Type_Definition; - end Has_Unit_Chain; - - function Has_Primary_Unit (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Physical_Type_Definition; - end Has_Primary_Unit; - - function Has_Identifier (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Design_Unit - | Iir_Kind_Library_Clause - | Iir_Kind_Record_Element_Constraint - | Iir_Kind_Record_Element_Resolution - | Iir_Kind_Protected_Type_Body - | Iir_Kind_Type_Declaration - | Iir_Kind_Anonymous_Type_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Nature_Declaration - | Iir_Kind_Subnature_Declaration - | Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Unit_Declaration - | Iir_Kind_Library_Declaration - | Iir_Kind_Component_Declaration - | Iir_Kind_Attribute_Declaration - | Iir_Kind_Group_Template_Declaration - | Iir_Kind_Group_Declaration - | Iir_Kind_Element_Declaration - | Iir_Kind_Non_Object_Alias_Declaration - | Iir_Kind_Psl_Declaration - | Iir_Kind_Terminal_Declaration - | Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Enumeration_Literal - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Interface_Package_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Psl_Default_Clock - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Concurrent_Procedure_Call_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement - | Iir_Kind_Component_Instantiation_Statement - | Iir_Kind_Simple_Simultaneous_Statement - | Iir_Kind_Signal_Assignment_Statement - | Iir_Kind_Null_Statement - | Iir_Kind_Assertion_Statement - | Iir_Kind_Report_Statement - | Iir_Kind_Wait_Statement - | Iir_Kind_Variable_Assignment_Statement - | Iir_Kind_Return_Statement - | Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement - | Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement - | Iir_Kind_Case_Statement - | Iir_Kind_Procedure_Call_Statement - | Iir_Kind_If_Statement - | Iir_Kind_Character_Literal - | Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Operator_Symbol - | Iir_Kind_Attribute_Name => - return True; - when others => - return False; - end case; - end Has_Identifier; - - function Has_Label (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Psl_Default_Clock - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Concurrent_Procedure_Call_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement - | Iir_Kind_Component_Instantiation_Statement - | Iir_Kind_Simple_Simultaneous_Statement - | Iir_Kind_Signal_Assignment_Statement - | Iir_Kind_Null_Statement - | Iir_Kind_Assertion_Statement - | Iir_Kind_Report_Statement - | Iir_Kind_Wait_Statement - | Iir_Kind_Variable_Assignment_Statement - | Iir_Kind_Return_Statement - | Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement - | Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement - | Iir_Kind_Case_Statement - | Iir_Kind_Procedure_Call_Statement - | Iir_Kind_If_Statement => - return True; - when others => - return False; - end case; - end Has_Label; - - function Has_Visible_Flag (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Record_Element_Constraint - | Iir_Kind_Type_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Nature_Declaration - | Iir_Kind_Subnature_Declaration - | Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Unit_Declaration - | Iir_Kind_Library_Declaration - | Iir_Kind_Component_Declaration - | Iir_Kind_Attribute_Declaration - | Iir_Kind_Group_Template_Declaration - | Iir_Kind_Group_Declaration - | Iir_Kind_Element_Declaration - | Iir_Kind_Non_Object_Alias_Declaration - | Iir_Kind_Psl_Declaration - | Iir_Kind_Terminal_Declaration - | Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Enumeration_Literal - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Interface_Package_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Concurrent_Procedure_Call_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement - | Iir_Kind_Component_Instantiation_Statement - | Iir_Kind_Simple_Simultaneous_Statement - | Iir_Kind_Signal_Assignment_Statement - | Iir_Kind_Null_Statement - | Iir_Kind_Assertion_Statement - | Iir_Kind_Report_Statement - | Iir_Kind_Wait_Statement - | Iir_Kind_Variable_Assignment_Statement - | Iir_Kind_Return_Statement - | Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement - | Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement - | Iir_Kind_Case_Statement - | Iir_Kind_Procedure_Call_Statement - | Iir_Kind_If_Statement => - return True; - when others => - return False; - end case; - end Has_Visible_Flag; - - function Has_Range_Constraint (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Subtype_Definition => - return True; - when others => - return False; - end case; - end Has_Range_Constraint; - - function Has_Direction (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Range_Expression; - end Has_Direction; - - function Has_Left_Limit (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Range_Expression; - end Has_Left_Limit; - - function Has_Right_Limit (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Range_Expression; - end Has_Right_Limit; - - function Has_Base_Type (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Error - | Iir_Kind_Access_Type_Definition - | Iir_Kind_Incomplete_Type_Definition - | Iir_Kind_File_Type_Definition - | Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Record_Type_Definition - | Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Access_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Integer_Type_Definition - | Iir_Kind_Floating_Type_Definition - | Iir_Kind_Physical_Type_Definition => - return True; - when others => - return False; - end case; - end Has_Base_Type; - - function Has_Resolution_Indication (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Array_Element_Resolution - | Iir_Kind_Record_Element_Resolution - | Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Subtype_Definition => - return True; - when others => - return False; - end case; - end Has_Resolution_Indication; - - function Has_Record_Element_Resolution_Chain (K : Iir_Kind) - return Boolean is - begin - return K = Iir_Kind_Record_Resolution; - end Has_Record_Element_Resolution_Chain; - - function Has_Tolerance (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Subtype_Definition - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Simple_Simultaneous_Statement => - return True; - when others => - return False; - end case; - end Has_Tolerance; - - function Has_Plus_Terminal (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration => - return True; - when others => - return False; - end case; - end Has_Plus_Terminal; - - function Has_Minus_Terminal (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration => - return True; - when others => - return False; - end case; - end Has_Minus_Terminal; - - function Has_Simultaneous_Left (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Simple_Simultaneous_Statement; - end Has_Simultaneous_Left; - - function Has_Simultaneous_Right (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Simple_Simultaneous_Statement; - end Has_Simultaneous_Right; - - function Has_Text_File_Flag (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_File_Type_Definition; - end Has_Text_File_Flag; - - function Has_Only_Characters_Flag (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Enumeration_Type_Definition; - end Has_Only_Characters_Flag; - - function Has_Type_Staticness (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Error - | Iir_Kind_Access_Type_Definition - | Iir_Kind_Incomplete_Type_Definition - | Iir_Kind_File_Type_Definition - | Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Record_Type_Definition - | Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Access_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Integer_Type_Definition - | Iir_Kind_Floating_Type_Definition - | Iir_Kind_Physical_Type_Definition => - return True; - when others => - return False; - end case; - end Has_Type_Staticness; - - function Has_Constraint_State (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Record_Type_Definition - | Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition => - return True; - when others => - return False; - end case; - end Has_Constraint_State; - - function Has_Index_Subtype_List (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition => - return True; - when others => - return False; - end case; - end Has_Index_Subtype_List; - - function Has_Index_Subtype_Definition_List (K : Iir_Kind) - return Boolean is - begin - return K = Iir_Kind_Array_Type_Definition; - end Has_Index_Subtype_Definition_List; - - function Has_Element_Subtype_Indication (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Array_Type_Definition; - end Has_Element_Subtype_Indication; - - function Has_Element_Subtype (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition => - return True; - when others => - return False; - end case; - end Has_Element_Subtype; - - function Has_Index_Constraint_List (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Array_Subtype_Definition; - end Has_Index_Constraint_List; - - function Has_Array_Element_Constraint (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Array_Subtype_Definition; - end Has_Array_Element_Constraint; - - function Has_Elements_Declaration_List (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Record_Type_Definition - | Iir_Kind_Record_Subtype_Definition => - return True; - when others => - return False; - end case; - end Has_Elements_Declaration_List; - - function Has_Designated_Type (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Access_Type_Definition - | Iir_Kind_Access_Subtype_Definition => - return True; - when others => - return False; - end case; - end Has_Designated_Type; - - function Has_Designated_Subtype_Indication (K : Iir_Kind) - return Boolean is - begin - case K is - when Iir_Kind_Access_Type_Definition - | Iir_Kind_Access_Subtype_Definition => - return True; - when others => - return False; - end case; - end Has_Designated_Subtype_Indication; - - function Has_Index_List (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Indexed_Name; - end Has_Index_List; - - function Has_Reference (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Scalar_Nature_Definition; - end Has_Reference; - - function Has_Nature_Declarator (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Scalar_Nature_Definition; - end Has_Nature_Declarator; - - function Has_Across_Type (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Scalar_Nature_Definition; - end Has_Across_Type; - - function Has_Through_Type (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Scalar_Nature_Definition; - end Has_Through_Type; - - function Has_Target (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Signal_Assignment_Statement - | Iir_Kind_Variable_Assignment_Statement => - return True; - when others => - return False; - end case; - end Has_Target; - - function Has_Waveform_Chain (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Conditional_Waveform - | Iir_Kind_Signal_Assignment_Statement => - return True; - when others => - return False; - end case; - end Has_Waveform_Chain; - - function Has_Guard (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment => - return True; - when others => - return False; - end case; - end Has_Guard; - - function Has_Delay_Mechanism (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Signal_Assignment_Statement => - return True; - when others => - return False; - end case; - end Has_Delay_Mechanism; - - function Has_Reject_Time_Expression (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Signal_Assignment_Statement => - return True; - when others => - return False; - end case; - end Has_Reject_Time_Expression; - - function Has_Sensitivity_List (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Wait_Statement => - return True; - when others => - return False; - end case; - end Has_Sensitivity_List; - - function Has_Process_Origin (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - return True; - when others => - return False; - end case; - end Has_Process_Origin; - - function Has_Condition_Clause (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Wait_Statement; - end Has_Condition_Clause; - - function Has_Timeout_Clause (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Wait_Statement; - end Has_Timeout_Clause; - - function Has_Postponed_Flag (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Concurrent_Procedure_Call_Statement => - return True; - when others => - return False; - end case; - end Has_Postponed_Flag; - - function Has_Callees_List (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - return True; - when others => - return False; - end case; - end Has_Callees_List; - - function Has_Passive_Flag (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Procedure_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - return True; - when others => - return False; - end case; - end Has_Passive_Flag; - - function Has_Resolution_Function_Flag (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Function_Declaration; - end Has_Resolution_Function_Flag; - - function Has_Wait_State (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - return True; - when others => - return False; - end case; - end Has_Wait_State; - - function Has_All_Sensitized_State (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => - return True; - when others => - return False; - end case; - end Has_All_Sensitized_State; - - function Has_Seen_Flag (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Enumeration_Literal - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - return True; - when others => - return False; - end case; - end Has_Seen_Flag; - - function Has_Pure_Flag (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration => - return True; - when others => - return False; - end case; - end Has_Pure_Flag; - - function Has_Foreign_Flag (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Architecture_Body - | Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => - return True; - when others => - return False; - end case; - end Has_Foreign_Flag; - - function Has_Resolved_Flag (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Error - | Iir_Kind_Access_Type_Definition - | Iir_Kind_Incomplete_Type_Definition - | Iir_Kind_File_Type_Definition - | Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Record_Type_Definition - | Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Access_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Integer_Type_Definition - | Iir_Kind_Floating_Type_Definition - | Iir_Kind_Physical_Type_Definition => - return True; - when others => - return False; - end case; - end Has_Resolved_Flag; - - function Has_Signal_Type_Flag (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Error - | Iir_Kind_Access_Type_Definition - | Iir_Kind_Incomplete_Type_Definition - | Iir_Kind_File_Type_Definition - | Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Record_Type_Definition - | Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Access_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Integer_Type_Definition - | Iir_Kind_Floating_Type_Definition - | Iir_Kind_Physical_Type_Definition => - return True; - when others => - return False; - end case; - end Has_Signal_Type_Flag; - - function Has_Has_Signal_Flag (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Error - | Iir_Kind_Incomplete_Type_Definition - | Iir_Kind_Record_Type_Definition - | Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Integer_Type_Definition - | Iir_Kind_Floating_Type_Definition - | Iir_Kind_Physical_Type_Definition => - return True; - when others => - return False; - end case; - end Has_Has_Signal_Flag; - - function Has_Purity_State (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Procedure_Declaration; - end Has_Purity_State; - - function Has_Elab_Flag (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Design_File - | Iir_Kind_Design_Unit => - return True; - when others => - return False; - end case; - end Has_Elab_Flag; - - function Has_Index_Constraint_Flag (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition => - return True; - when others => - return False; - end case; - end Has_Index_Constraint_Flag; - - function Has_Assertion_Condition (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Assertion_Statement => - return True; - when others => - return False; - end case; - end Has_Assertion_Condition; - - function Has_Report_Expression (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Assertion_Statement - | Iir_Kind_Report_Statement => - return True; - when others => - return False; - end case; - end Has_Report_Expression; - - function Has_Severity_Expression (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Assertion_Statement - | Iir_Kind_Report_Statement => - return True; - when others => - return False; - end case; - end Has_Severity_Expression; - - function Has_Instantiated_Unit (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Component_Instantiation_Statement; - end Has_Instantiated_Unit; - - function Has_Generic_Map_Aspect_Chain (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Block_Header - | Iir_Kind_Binding_Indication - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Header - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Interface_Package_Declaration - | Iir_Kind_Component_Instantiation_Statement => - return True; - when others => - return False; - end case; - end Has_Generic_Map_Aspect_Chain; - - function Has_Port_Map_Aspect_Chain (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Block_Header - | Iir_Kind_Binding_Indication - | Iir_Kind_Component_Instantiation_Statement => - return True; - when others => - return False; - end case; - end Has_Port_Map_Aspect_Chain; - - function Has_Configuration_Name (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Entity_Aspect_Configuration; - end Has_Configuration_Name; - - function Has_Component_Configuration (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Component_Instantiation_Statement; - end Has_Component_Configuration; - - function Has_Configuration_Specification (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Component_Instantiation_Statement; - end Has_Configuration_Specification; - - function Has_Default_Binding_Indication (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Component_Instantiation_Statement; - end Has_Default_Binding_Indication; - - function Has_Default_Configuration_Declaration (K : Iir_Kind) - return Boolean is - begin - return K = Iir_Kind_Architecture_Body; - end Has_Default_Configuration_Declaration; - - function Has_Expression (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Attribute_Specification - | Iir_Kind_Disconnection_Specification - | Iir_Kind_Parenthesis_Expression - | Iir_Kind_Qualified_Expression - | Iir_Kind_Type_Conversion - | Iir_Kind_Allocator_By_Expression - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Variable_Assignment_Statement - | Iir_Kind_Return_Statement - | Iir_Kind_Case_Statement => - return True; - when others => - return False; - end case; - end Has_Expression; - - function Has_Allocator_Designated_Type (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Allocator_By_Expression - | Iir_Kind_Allocator_By_Subtype => - return True; - when others => - return False; - end case; - end Has_Allocator_Designated_Type; - - function Has_Selected_Waveform_Chain (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Concurrent_Selected_Signal_Assignment; - end Has_Selected_Waveform_Chain; - - function Has_Conditional_Waveform_Chain (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Concurrent_Conditional_Signal_Assignment; - end Has_Conditional_Waveform_Chain; - - function Has_Guard_Expression (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Guard_Signal_Declaration; - end Has_Guard_Expression; - - function Has_Guard_Decl (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Block_Statement; - end Has_Guard_Decl; - - function Has_Guard_Sensitivity_List (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Guard_Signal_Declaration; - end Has_Guard_Sensitivity_List; - - function Has_Block_Block_Configuration (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Block_Statement; - end Has_Block_Block_Configuration; - - function Has_Package_Header (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Package_Declaration; - end Has_Package_Header; - - function Has_Block_Header (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Block_Statement; - end Has_Block_Header; - - function Has_Uninstantiated_Package_Name (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Interface_Package_Declaration => - return True; - when others => - return False; - end case; - end Has_Uninstantiated_Package_Name; - - function Has_Generate_Block_Configuration (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Generate_Statement; - end Has_Generate_Block_Configuration; - - function Has_Generation_Scheme (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Generate_Statement; - end Has_Generation_Scheme; - - function Has_Condition (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Conditional_Waveform - | Iir_Kind_While_Loop_Statement - | Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement - | Iir_Kind_If_Statement - | Iir_Kind_Elsif => - return True; - when others => - return False; - end case; - end Has_Condition; - - function Has_Else_Clause (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_If_Statement - | Iir_Kind_Elsif => - return True; - when others => - return False; - end case; - end Has_Else_Clause; - - function Has_Parameter_Specification (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_For_Loop_Statement; - end Has_Parameter_Specification; - - function Has_Parent (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Design_File - | Iir_Kind_Design_Unit - | Iir_Kind_Library_Clause - | Iir_Kind_Use_Clause - | Iir_Kind_Choice_By_Others - | Iir_Kind_Choice_By_Expression - | Iir_Kind_Choice_By_Range - | Iir_Kind_Choice_By_None - | Iir_Kind_Choice_By_Name - | Iir_Kind_Block_Configuration - | Iir_Kind_Component_Configuration - | Iir_Kind_Record_Element_Constraint - | Iir_Kind_Attribute_Specification - | Iir_Kind_Disconnection_Specification - | Iir_Kind_Configuration_Specification - | Iir_Kind_Protected_Type_Body - | Iir_Kind_Type_Declaration - | Iir_Kind_Anonymous_Type_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Nature_Declaration - | Iir_Kind_Subnature_Declaration - | Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Unit_Declaration - | Iir_Kind_Component_Declaration - | Iir_Kind_Attribute_Declaration - | Iir_Kind_Group_Template_Declaration - | Iir_Kind_Group_Declaration - | Iir_Kind_Non_Object_Alias_Declaration - | Iir_Kind_Psl_Declaration - | Iir_Kind_Terminal_Declaration - | Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Enumeration_Literal - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Interface_Package_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Psl_Default_Clock - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Concurrent_Procedure_Call_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement - | Iir_Kind_Component_Instantiation_Statement - | Iir_Kind_Simple_Simultaneous_Statement - | Iir_Kind_Signal_Assignment_Statement - | Iir_Kind_Null_Statement - | Iir_Kind_Assertion_Statement - | Iir_Kind_Report_Statement - | Iir_Kind_Wait_Statement - | Iir_Kind_Variable_Assignment_Statement - | Iir_Kind_Return_Statement - | Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement - | Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement - | Iir_Kind_Case_Statement - | Iir_Kind_Procedure_Call_Statement - | Iir_Kind_If_Statement - | Iir_Kind_Elsif => - return True; - when others => - return False; - end case; - end Has_Parent; - - function Has_Loop_Label (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement => - return True; - when others => - return False; - end case; - end Has_Loop_Label; - - function Has_Component_Name (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Component_Configuration - | Iir_Kind_Configuration_Specification => - return True; - when others => - return False; - end case; - end Has_Component_Name; - - function Has_Instantiation_List (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Component_Configuration - | Iir_Kind_Configuration_Specification => - return True; - when others => - return False; - end case; - end Has_Instantiation_List; - - function Has_Entity_Aspect (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Binding_Indication; - end Has_Entity_Aspect; - - function Has_Default_Entity_Aspect (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Binding_Indication; - end Has_Default_Entity_Aspect; - - function Has_Default_Generic_Map_Aspect_Chain (K : Iir_Kind) - return Boolean is - begin - return K = Iir_Kind_Binding_Indication; - end Has_Default_Generic_Map_Aspect_Chain; - - function Has_Default_Port_Map_Aspect_Chain (K : Iir_Kind) - return Boolean is - begin - return K = Iir_Kind_Binding_Indication; - end Has_Default_Port_Map_Aspect_Chain; - - function Has_Binding_Indication (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Component_Configuration - | Iir_Kind_Configuration_Specification => - return True; - when others => - return False; - end case; - end Has_Binding_Indication; - - function Has_Named_Entity (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Character_Literal - | Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Operator_Symbol - | Iir_Kind_Selected_By_All_Name - | Iir_Kind_Parenthesis_Name - | Iir_Kind_Attribute_Name => - return True; - when others => - return False; - end case; - end Has_Named_Entity; - - function Has_Alias_Declaration (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Character_Literal - | Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Operator_Symbol => - return True; - when others => - return False; - end case; - end Has_Alias_Declaration; - - function Has_Expr_Staticness (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Error - | Iir_Kind_Integer_Literal - | Iir_Kind_Floating_Point_Literal - | Iir_Kind_Null_Literal - | Iir_Kind_String_Literal - | Iir_Kind_Physical_Int_Literal - | Iir_Kind_Physical_Fp_Literal - | Iir_Kind_Bit_String_Literal - | Iir_Kind_Simple_Aggregate - | Iir_Kind_Overflow_Literal - | Iir_Kind_Attribute_Value - | Iir_Kind_Range_Expression - | Iir_Kind_Unit_Declaration - | Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Enumeration_Literal - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Identity_Operator - | Iir_Kind_Negation_Operator - | Iir_Kind_Absolute_Operator - | Iir_Kind_Not_Operator - | Iir_Kind_Condition_Operator - | Iir_Kind_Reduction_And_Operator - | Iir_Kind_Reduction_Or_Operator - | Iir_Kind_Reduction_Nand_Operator - | Iir_Kind_Reduction_Nor_Operator - | Iir_Kind_Reduction_Xor_Operator - | Iir_Kind_Reduction_Xnor_Operator - | Iir_Kind_And_Operator - | Iir_Kind_Or_Operator - | Iir_Kind_Nand_Operator - | Iir_Kind_Nor_Operator - | Iir_Kind_Xor_Operator - | Iir_Kind_Xnor_Operator - | Iir_Kind_Equality_Operator - | Iir_Kind_Inequality_Operator - | Iir_Kind_Less_Than_Operator - | Iir_Kind_Less_Than_Or_Equal_Operator - | Iir_Kind_Greater_Than_Operator - | Iir_Kind_Greater_Than_Or_Equal_Operator - | Iir_Kind_Match_Equality_Operator - | Iir_Kind_Match_Inequality_Operator - | Iir_Kind_Match_Less_Than_Operator - | Iir_Kind_Match_Less_Than_Or_Equal_Operator - | Iir_Kind_Match_Greater_Than_Operator - | Iir_Kind_Match_Greater_Than_Or_Equal_Operator - | Iir_Kind_Sll_Operator - | Iir_Kind_Sla_Operator - | Iir_Kind_Srl_Operator - | Iir_Kind_Sra_Operator - | Iir_Kind_Rol_Operator - | Iir_Kind_Ror_Operator - | Iir_Kind_Addition_Operator - | Iir_Kind_Substraction_Operator - | Iir_Kind_Concatenation_Operator - | Iir_Kind_Multiplication_Operator - | Iir_Kind_Division_Operator - | Iir_Kind_Modulus_Operator - | Iir_Kind_Remainder_Operator - | Iir_Kind_Exponentiation_Operator - | Iir_Kind_Function_Call - | Iir_Kind_Aggregate - | Iir_Kind_Parenthesis_Expression - | Iir_Kind_Qualified_Expression - | Iir_Kind_Type_Conversion - | Iir_Kind_Allocator_By_Expression - | Iir_Kind_Allocator_By_Subtype - | Iir_Kind_Selected_Element - | Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference - | Iir_Kind_Slice_Name - | Iir_Kind_Indexed_Name - | Iir_Kind_Character_Literal - | Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Selected_By_All_Name - | Iir_Kind_Left_Type_Attribute - | Iir_Kind_Right_Type_Attribute - | Iir_Kind_High_Type_Attribute - | Iir_Kind_Low_Type_Attribute - | Iir_Kind_Ascending_Type_Attribute - | Iir_Kind_Image_Attribute - | Iir_Kind_Value_Attribute - | Iir_Kind_Pos_Attribute - | Iir_Kind_Val_Attribute - | Iir_Kind_Succ_Attribute - | Iir_Kind_Pred_Attribute - | Iir_Kind_Leftof_Attribute - | Iir_Kind_Rightof_Attribute - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute - | Iir_Kind_Event_Attribute - | Iir_Kind_Active_Attribute - | Iir_Kind_Last_Event_Attribute - | Iir_Kind_Last_Active_Attribute - | Iir_Kind_Last_Value_Attribute - | Iir_Kind_Driving_Attribute - | Iir_Kind_Driving_Value_Attribute - | Iir_Kind_Simple_Name_Attribute - | Iir_Kind_Instance_Name_Attribute - | Iir_Kind_Path_Name_Attribute - | Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute - | Iir_Kind_Attribute_Name => - return True; - when others => - return False; - end case; - end Has_Expr_Staticness; - - function Has_Error_Origin (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Error; - end Has_Error_Origin; - - function Has_Operand (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Identity_Operator - | Iir_Kind_Negation_Operator - | Iir_Kind_Absolute_Operator - | Iir_Kind_Not_Operator - | Iir_Kind_Condition_Operator - | Iir_Kind_Reduction_And_Operator - | Iir_Kind_Reduction_Or_Operator - | Iir_Kind_Reduction_Nand_Operator - | Iir_Kind_Reduction_Nor_Operator - | Iir_Kind_Reduction_Xor_Operator - | Iir_Kind_Reduction_Xnor_Operator => - return True; - when others => - return False; - end case; - end Has_Operand; - - function Has_Left (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_And_Operator - | Iir_Kind_Or_Operator - | Iir_Kind_Nand_Operator - | Iir_Kind_Nor_Operator - | Iir_Kind_Xor_Operator - | Iir_Kind_Xnor_Operator - | Iir_Kind_Equality_Operator - | Iir_Kind_Inequality_Operator - | Iir_Kind_Less_Than_Operator - | Iir_Kind_Less_Than_Or_Equal_Operator - | Iir_Kind_Greater_Than_Operator - | Iir_Kind_Greater_Than_Or_Equal_Operator - | Iir_Kind_Match_Equality_Operator - | Iir_Kind_Match_Inequality_Operator - | Iir_Kind_Match_Less_Than_Operator - | Iir_Kind_Match_Less_Than_Or_Equal_Operator - | Iir_Kind_Match_Greater_Than_Operator - | Iir_Kind_Match_Greater_Than_Or_Equal_Operator - | Iir_Kind_Sll_Operator - | Iir_Kind_Sla_Operator - | Iir_Kind_Srl_Operator - | Iir_Kind_Sra_Operator - | Iir_Kind_Rol_Operator - | Iir_Kind_Ror_Operator - | Iir_Kind_Addition_Operator - | Iir_Kind_Substraction_Operator - | Iir_Kind_Concatenation_Operator - | Iir_Kind_Multiplication_Operator - | Iir_Kind_Division_Operator - | Iir_Kind_Modulus_Operator - | Iir_Kind_Remainder_Operator - | Iir_Kind_Exponentiation_Operator => - return True; - when others => - return False; - end case; - end Has_Left; - - function Has_Right (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_And_Operator - | Iir_Kind_Or_Operator - | Iir_Kind_Nand_Operator - | Iir_Kind_Nor_Operator - | Iir_Kind_Xor_Operator - | Iir_Kind_Xnor_Operator - | Iir_Kind_Equality_Operator - | Iir_Kind_Inequality_Operator - | Iir_Kind_Less_Than_Operator - | Iir_Kind_Less_Than_Or_Equal_Operator - | Iir_Kind_Greater_Than_Operator - | Iir_Kind_Greater_Than_Or_Equal_Operator - | Iir_Kind_Match_Equality_Operator - | Iir_Kind_Match_Inequality_Operator - | Iir_Kind_Match_Less_Than_Operator - | Iir_Kind_Match_Less_Than_Or_Equal_Operator - | Iir_Kind_Match_Greater_Than_Operator - | Iir_Kind_Match_Greater_Than_Or_Equal_Operator - | Iir_Kind_Sll_Operator - | Iir_Kind_Sla_Operator - | Iir_Kind_Srl_Operator - | Iir_Kind_Sra_Operator - | Iir_Kind_Rol_Operator - | Iir_Kind_Ror_Operator - | Iir_Kind_Addition_Operator - | Iir_Kind_Substraction_Operator - | Iir_Kind_Concatenation_Operator - | Iir_Kind_Multiplication_Operator - | Iir_Kind_Division_Operator - | Iir_Kind_Modulus_Operator - | Iir_Kind_Remainder_Operator - | Iir_Kind_Exponentiation_Operator => - return True; - when others => - return False; - end case; - end Has_Right; - - function Has_Unit_Name (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Physical_Int_Literal - | Iir_Kind_Physical_Fp_Literal => - return True; - when others => - return False; - end case; - end Has_Unit_Name; - - function Has_Name (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Non_Object_Alias_Declaration - | Iir_Kind_Object_Alias_Declaration => - return True; - when others => - return False; - end case; - end Has_Name; - - function Has_Group_Template_Name (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Group_Declaration; - end Has_Group_Template_Name; - - function Has_Name_Staticness (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Attribute_Value - | Iir_Kind_Unit_Declaration - | Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Enumeration_Literal - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Function_Call - | Iir_Kind_Selected_Element - | Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference - | Iir_Kind_Slice_Name - | Iir_Kind_Indexed_Name - | Iir_Kind_Character_Literal - | Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Left_Type_Attribute - | Iir_Kind_Right_Type_Attribute - | Iir_Kind_High_Type_Attribute - | Iir_Kind_Low_Type_Attribute - | Iir_Kind_Ascending_Type_Attribute - | Iir_Kind_Image_Attribute - | Iir_Kind_Value_Attribute - | Iir_Kind_Pos_Attribute - | Iir_Kind_Val_Attribute - | Iir_Kind_Succ_Attribute - | Iir_Kind_Pred_Attribute - | Iir_Kind_Leftof_Attribute - | Iir_Kind_Rightof_Attribute - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute - | Iir_Kind_Event_Attribute - | Iir_Kind_Active_Attribute - | Iir_Kind_Last_Event_Attribute - | Iir_Kind_Last_Active_Attribute - | Iir_Kind_Last_Value_Attribute - | Iir_Kind_Driving_Attribute - | Iir_Kind_Driving_Value_Attribute - | Iir_Kind_Simple_Name_Attribute - | Iir_Kind_Instance_Name_Attribute - | Iir_Kind_Path_Name_Attribute - | Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute - | Iir_Kind_Attribute_Name => - return True; - when others => - return False; - end case; - end Has_Name_Staticness; - - function Has_Prefix (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Procedure_Call - | Iir_Kind_Function_Call - | Iir_Kind_Selected_Element - | Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference - | Iir_Kind_Slice_Name - | Iir_Kind_Indexed_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Selected_By_All_Name - | Iir_Kind_Parenthesis_Name - | Iir_Kind_Base_Attribute - | Iir_Kind_Left_Type_Attribute - | Iir_Kind_Right_Type_Attribute - | Iir_Kind_High_Type_Attribute - | Iir_Kind_Low_Type_Attribute - | Iir_Kind_Ascending_Type_Attribute - | Iir_Kind_Image_Attribute - | Iir_Kind_Value_Attribute - | Iir_Kind_Pos_Attribute - | Iir_Kind_Val_Attribute - | Iir_Kind_Succ_Attribute - | Iir_Kind_Pred_Attribute - | Iir_Kind_Leftof_Attribute - | Iir_Kind_Rightof_Attribute - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute - | Iir_Kind_Event_Attribute - | Iir_Kind_Active_Attribute - | Iir_Kind_Last_Event_Attribute - | Iir_Kind_Last_Active_Attribute - | Iir_Kind_Last_Value_Attribute - | Iir_Kind_Driving_Attribute - | Iir_Kind_Driving_Value_Attribute - | Iir_Kind_Simple_Name_Attribute - | Iir_Kind_Instance_Name_Attribute - | Iir_Kind_Path_Name_Attribute - | Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute - | Iir_Kind_Attribute_Name => - return True; - when others => - return False; - end case; - end Has_Prefix; - - function Has_Signature_Prefix (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Signature; - end Has_Signature_Prefix; - - function Has_Slice_Subtype (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Slice_Name; - end Has_Slice_Subtype; - - function Has_Suffix (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Slice_Name; - end Has_Suffix; - - function Has_Index_Subtype (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute => - return True; - when others => - return False; - end case; - end Has_Index_Subtype; - - function Has_Parameter (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Image_Attribute - | Iir_Kind_Value_Attribute - | Iir_Kind_Pos_Attribute - | Iir_Kind_Val_Attribute - | Iir_Kind_Succ_Attribute - | Iir_Kind_Pred_Attribute - | Iir_Kind_Leftof_Attribute - | Iir_Kind_Rightof_Attribute - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute - | Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute => - return True; - when others => - return False; - end case; - end Has_Parameter; - - function Has_Actual_Type (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Association_Element_By_Individual; - end Has_Actual_Type; - - function Has_Associated_Interface (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Association_Element_Package; - end Has_Associated_Interface; - - function Has_Association_Chain (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Parenthesis_Name; - end Has_Association_Chain; - - function Has_Individual_Association_Chain (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Association_Element_By_Individual; - end Has_Individual_Association_Chain; - - function Has_Aggregate_Info (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Aggregate; - end Has_Aggregate_Info; - - function Has_Sub_Aggregate_Info (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Aggregate_Info; - end Has_Sub_Aggregate_Info; - - function Has_Aggr_Dynamic_Flag (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Aggregate_Info; - end Has_Aggr_Dynamic_Flag; - - function Has_Aggr_Min_Length (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Aggregate_Info; - end Has_Aggr_Min_Length; - - function Has_Aggr_Low_Limit (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Aggregate_Info; - end Has_Aggr_Low_Limit; - - function Has_Aggr_High_Limit (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Aggregate_Info; - end Has_Aggr_High_Limit; - - function Has_Aggr_Others_Flag (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Aggregate_Info; - end Has_Aggr_Others_Flag; - - function Has_Aggr_Named_Flag (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Aggregate_Info; - end Has_Aggr_Named_Flag; - - function Has_Value_Staticness (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Aggregate; - end Has_Value_Staticness; - - function Has_Association_Choices_Chain (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Aggregate; - end Has_Association_Choices_Chain; - - function Has_Case_Statement_Alternative_Chain (K : Iir_Kind) - return Boolean is - begin - return K = Iir_Kind_Case_Statement; - end Has_Case_Statement_Alternative_Chain; - - function Has_Choice_Staticness (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Choice_By_Expression - | Iir_Kind_Choice_By_Range => - return True; - when others => - return False; - end case; - end Has_Choice_Staticness; - - function Has_Procedure_Call (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Concurrent_Procedure_Call_Statement - | Iir_Kind_Procedure_Call_Statement => - return True; - when others => - return False; - end case; - end Has_Procedure_Call; - - function Has_Implementation (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Procedure_Call - | Iir_Kind_Identity_Operator - | Iir_Kind_Negation_Operator - | Iir_Kind_Absolute_Operator - | Iir_Kind_Not_Operator - | Iir_Kind_Condition_Operator - | Iir_Kind_Reduction_And_Operator - | Iir_Kind_Reduction_Or_Operator - | Iir_Kind_Reduction_Nand_Operator - | Iir_Kind_Reduction_Nor_Operator - | Iir_Kind_Reduction_Xor_Operator - | Iir_Kind_Reduction_Xnor_Operator - | Iir_Kind_And_Operator - | Iir_Kind_Or_Operator - | Iir_Kind_Nand_Operator - | Iir_Kind_Nor_Operator - | Iir_Kind_Xor_Operator - | Iir_Kind_Xnor_Operator - | Iir_Kind_Equality_Operator - | Iir_Kind_Inequality_Operator - | Iir_Kind_Less_Than_Operator - | Iir_Kind_Less_Than_Or_Equal_Operator - | Iir_Kind_Greater_Than_Operator - | Iir_Kind_Greater_Than_Or_Equal_Operator - | Iir_Kind_Match_Equality_Operator - | Iir_Kind_Match_Inequality_Operator - | Iir_Kind_Match_Less_Than_Operator - | Iir_Kind_Match_Less_Than_Or_Equal_Operator - | Iir_Kind_Match_Greater_Than_Operator - | Iir_Kind_Match_Greater_Than_Or_Equal_Operator - | Iir_Kind_Sll_Operator - | Iir_Kind_Sla_Operator - | Iir_Kind_Srl_Operator - | Iir_Kind_Sra_Operator - | Iir_Kind_Rol_Operator - | Iir_Kind_Ror_Operator - | Iir_Kind_Addition_Operator - | Iir_Kind_Substraction_Operator - | Iir_Kind_Concatenation_Operator - | Iir_Kind_Multiplication_Operator - | Iir_Kind_Division_Operator - | Iir_Kind_Modulus_Operator - | Iir_Kind_Remainder_Operator - | Iir_Kind_Exponentiation_Operator - | Iir_Kind_Function_Call => - return True; - when others => - return False; - end case; - end Has_Implementation; - - function Has_Parameter_Association_Chain (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Procedure_Call - | Iir_Kind_Function_Call => - return True; - when others => - return False; - end case; - end Has_Parameter_Association_Chain; - - function Has_Method_Object (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Procedure_Call - | Iir_Kind_Function_Call => - return True; - when others => - return False; - end case; - end Has_Method_Object; - - function Has_Subtype_Type_Mark (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Access_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Subtype_Definition => - return True; - when others => - return False; - end case; - end Has_Subtype_Type_Mark; - - function Has_Type_Conversion_Subtype (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Type_Conversion; - end Has_Type_Conversion_Subtype; - - function Has_Type_Mark (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Disconnection_Specification - | Iir_Kind_Attribute_Declaration - | Iir_Kind_Qualified_Expression - | Iir_Kind_Type_Conversion => - return True; - when others => - return False; - end case; - end Has_Type_Mark; - - function Has_File_Type_Mark (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_File_Type_Definition; - end Has_File_Type_Mark; - - function Has_Return_Type_Mark (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Signature - | Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => - return True; - when others => - return False; - end case; - end Has_Return_Type_Mark; - - function Has_Lexical_Layout (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_File_Declaration => - return True; - when others => - return False; - end case; - end Has_Lexical_Layout; - - function Has_Incomplete_Type_List (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Incomplete_Type_Definition; - end Has_Incomplete_Type_List; - - function Has_Has_Disconnect_Flag (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Signal_Declaration - | Iir_Kind_Interface_Signal_Declaration => - return True; - when others => - return False; - end case; - end Has_Has_Disconnect_Flag; - - function Has_Has_Active_Flag (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute => - return True; - when others => - return False; - end case; - end Has_Has_Active_Flag; - - function Has_Is_Within_Flag (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Enumeration_Literal - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_For_Loop_Statement => - return True; - when others => - return False; - end case; - end Has_Is_Within_Flag; - - function Has_Type_Marks_List (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Signature; - end Has_Type_Marks_List; - - function Has_Implicit_Alias_Flag (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Non_Object_Alias_Declaration; - end Has_Implicit_Alias_Flag; - - function Has_Alias_Signature (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Non_Object_Alias_Declaration; - end Has_Alias_Signature; - - function Has_Attribute_Signature (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Attribute_Name; - end Has_Attribute_Signature; - - function Has_Overload_List (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Overload_List; - end Has_Overload_List; - - function Has_Simple_Name_Identifier (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Simple_Name_Attribute; - end Has_Simple_Name_Identifier; - - function Has_Simple_Name_Subtype (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Simple_Name_Attribute; - end Has_Simple_Name_Subtype; - - function Has_Protected_Type_Body (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Protected_Type_Declaration; - end Has_Protected_Type_Body; - - function Has_Protected_Type_Declaration (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Protected_Type_Body; - end Has_Protected_Type_Declaration; - - function Has_End_Location (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Design_Unit; - end Has_End_Location; - - function Has_String_Id (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal => - return True; - when others => - return False; - end case; - end Has_String_Id; - - function Has_String_Length (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal => - return True; - when others => - return False; - end case; - end Has_String_Length; - - function Has_Use_Flag (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Type_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Nature_Declaration - | Iir_Kind_Subnature_Declaration - | Iir_Kind_Component_Declaration - | Iir_Kind_Attribute_Declaration - | Iir_Kind_Group_Template_Declaration - | Iir_Kind_Group_Declaration - | Iir_Kind_Non_Object_Alias_Declaration - | Iir_Kind_Psl_Declaration - | Iir_Kind_Terminal_Declaration - | Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_File_Declaration => - return True; - when others => - return False; - end case; - end Has_Use_Flag; - - function Has_End_Has_Reserved_Id (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Record_Type_Definition - | Iir_Kind_Physical_Type_Definition - | Iir_Kind_Protected_Type_Body - | Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Component_Declaration - | Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement => - return True; - when others => - return False; - end case; - end Has_End_Has_Reserved_Id; - - function Has_End_Has_Identifier (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Record_Type_Definition - | Iir_Kind_Physical_Type_Definition - | Iir_Kind_Protected_Type_Body - | Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Component_Declaration - | Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement - | Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement - | Iir_Kind_Case_Statement - | Iir_Kind_If_Statement - | Iir_Kind_Elsif => - return True; - when others => - return False; - end case; - end Has_End_Has_Identifier; - - function Has_End_Has_Postponed (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - return True; - when others => - return False; - end case; - end Has_End_Has_Postponed; - - function Has_Has_Begin (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Entity_Declaration - | Iir_Kind_Generate_Statement => - return True; - when others => - return False; - end case; - end Has_Has_Begin; - - function Has_Has_Is (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Component_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - return True; - when others => - return False; - end case; - end Has_Has_Is; - - function Has_Has_Pure (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Function_Declaration; - end Has_Has_Pure; - - function Has_Has_Body (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => - return True; - when others => - return False; - end case; - end Has_Has_Body; - - function Has_Has_Identifier_List (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Library_Clause - | Iir_Kind_Element_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration => - return True; - when others => - return False; - end case; - end Has_Has_Identifier_List; - - function Has_Has_Mode (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_File_Declaration; - end Has_Has_Mode; - - function Has_Is_Ref (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Subtype_Declaration - | Iir_Kind_Element_Declaration - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_File_Declaration => - return True; - when others => - return False; - end case; - end Has_Is_Ref; - - function Has_Psl_Property (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement => - return True; - when others => - return False; - end case; - end Has_Psl_Property; - - function Has_Psl_Declaration (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Psl_Declaration; - end Has_Psl_Declaration; - - function Has_Psl_Expression (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Psl_Expression; - end Has_Psl_Expression; - - function Has_Psl_Boolean (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Psl_Default_Clock; - end Has_Psl_Boolean; - - function Has_PSL_Clock (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Psl_Declaration - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement => - return True; - when others => - return False; - end case; - end Has_PSL_Clock; - - function Has_PSL_NFA (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Psl_Declaration - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement => - return True; - when others => - return False; - end case; - end Has_PSL_NFA; - -end Nodes_Meta; diff --git a/nodes_meta.adb.in b/nodes_meta.adb.in deleted file mode 100644 index d94c2d626..000000000 --- a/nodes_meta.adb.in +++ /dev/null @@ -1,76 +0,0 @@ --- Meta description of nodes. --- Copyright (C) 2014 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -package body Nodes_Meta is - Fields_Type : constant array (Fields_Enum) of Types_Enum := - ( - -- FIELDS_TYPE - ); - - function Get_Field_Type (F : Fields_Enum) return Types_Enum is - begin - return Fields_Type (F); - end Get_Field_Type; - - function Get_Field_Image (F : Fields_Enum) return String is - begin - case F is - -- FIELD_IMAGE - end case; - end Get_Field_Image; - - function Get_Iir_Image (K : Iir_Kind) return String is - begin - case K is - -- IIR_IMAGE - end case; - end Get_Iir_Image; - - function Get_Field_Attribute (F : Fields_Enum) return Field_Attribute is - begin - case F is - -- FIELD_ATTRIBUTE - end case; - end Get_Field_Attribute; - - Fields_Of_Iir : constant Fields_Array := - ( - -- FIELDS_ARRAY - ); - - Fields_Of_Iir_Last : constant array (Iir_Kind) of Integer := - ( - -- FIELDS_ARRAY_POS - ); - - function Get_Fields (K : Iir_Kind) return Fields_Array - is - First : Natural; - Last : Integer; - begin - if K = Iir_Kind'First then - First := Fields_Of_Iir'First; - else - First := Fields_Of_Iir_Last (Iir_Kind'Pred (K)) + 1; - end if; - Last := Fields_Of_Iir_Last (K); - return Fields_Of_Iir (First .. Last); - end Get_Fields; - - -- FUNCS_BODY -end Nodes_Meta; diff --git a/nodes_meta.ads b/nodes_meta.ads deleted file mode 100644 index 2d1f5e1c0..000000000 --- a/nodes_meta.ads +++ /dev/null @@ -1,823 +0,0 @@ --- Meta description of nodes. --- Copyright (C) 2014 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Types; use Types; -with Iirs; use Iirs; -with Tokens; use Tokens; - -package Nodes_Meta is - -- The enumeration of all possible types in the nodes. - type Types_Enum is - ( - Type_Base_Type, - Type_Boolean, - Type_Date_State_Type, - Type_Date_Type, - Type_Iir, - Type_Iir_All_Sensitized, - Type_Iir_Constraint, - Type_Iir_Delay_Mechanism, - Type_Iir_Direction, - Type_Iir_Fp64, - Type_Iir_Index32, - Type_Iir_Int32, - Type_Iir_Int64, - Type_Iir_Lexical_Layout_Type, - Type_Iir_List, - Type_Iir_Mode, - Type_Iir_Predefined_Functions, - Type_Iir_Pure_State, - Type_Iir_Signal_Kind, - Type_Iir_Staticness, - Type_Int32, - Type_Location_Type, - Type_Name_Id, - Type_PSL_NFA, - Type_PSL_Node, - Type_Source_Ptr, - Type_String_Id, - Type_Time_Stamp_Id, - Type_Token_Type, - Type_Tri_State_Type - ); - - -- The enumeration of all fields defined in iirs. - type Fields_Enum is - ( - Field_First_Design_Unit, - Field_Last_Design_Unit, - Field_Library_Declaration, - Field_File_Time_Stamp, - Field_Analysis_Time_Stamp, - Field_Library, - Field_File_Dependence_List, - Field_Design_File_Filename, - Field_Design_File_Directory, - Field_Design_File, - Field_Design_File_Chain, - Field_Library_Directory, - Field_Date, - Field_Context_Items, - Field_Dependence_List, - Field_Analysis_Checks_List, - Field_Date_State, - Field_Guarded_Target_State, - Field_Library_Unit, - Field_Hash_Chain, - Field_Design_Unit_Source_Pos, - Field_Design_Unit_Source_Line, - Field_Design_Unit_Source_Col, - Field_Value, - Field_Enum_Pos, - Field_Physical_Literal, - Field_Physical_Unit_Value, - Field_Fp_Value, - Field_Enumeration_Decl, - Field_Simple_Aggregate_List, - Field_Bit_String_Base, - Field_Bit_String_0, - Field_Bit_String_1, - Field_Literal_Origin, - Field_Range_Origin, - Field_Literal_Subtype, - Field_Entity_Class, - Field_Entity_Name_List, - Field_Attribute_Designator, - Field_Attribute_Specification_Chain, - Field_Attribute_Specification, - Field_Signal_List, - Field_Designated_Entity, - Field_Formal, - Field_Actual, - Field_In_Conversion, - Field_Out_Conversion, - Field_Whole_Association_Flag, - Field_Collapse_Signal_Flag, - Field_Artificial_Flag, - Field_Open_Flag, - Field_After_Drivers_Flag, - Field_We_Value, - Field_Time, - Field_Associated_Expr, - Field_Associated_Chain, - Field_Choice_Name, - Field_Choice_Expression, - Field_Choice_Range, - Field_Same_Alternative_Flag, - Field_Architecture, - Field_Block_Specification, - Field_Prev_Block_Configuration, - Field_Configuration_Item_Chain, - Field_Attribute_Value_Chain, - Field_Spec_Chain, - Field_Attribute_Value_Spec_Chain, - Field_Entity_Name, - Field_Package, - Field_Package_Body, - Field_Need_Body, - Field_Block_Configuration, - Field_Concurrent_Statement_Chain, - Field_Chain, - Field_Port_Chain, - Field_Generic_Chain, - Field_Type, - Field_Subtype_Indication, - Field_Discrete_Range, - Field_Type_Definition, - Field_Subtype_Definition, - Field_Nature, - Field_Mode, - Field_Signal_Kind, - Field_Base_Name, - Field_Interface_Declaration_Chain, - Field_Subprogram_Specification, - Field_Sequential_Statement_Chain, - Field_Subprogram_Body, - Field_Overload_Number, - Field_Subprogram_Depth, - Field_Subprogram_Hash, - Field_Impure_Depth, - Field_Return_Type, - Field_Implicit_Definition, - Field_Type_Reference, - Field_Default_Value, - Field_Deferred_Declaration, - Field_Deferred_Declaration_Flag, - Field_Shared_Flag, - Field_Design_Unit, - Field_Block_Statement, - Field_Signal_Driver, - Field_Declaration_Chain, - Field_File_Logical_Name, - Field_File_Open_Kind, - Field_Element_Position, - Field_Element_Declaration, - Field_Selected_Element, - Field_Use_Clause_Chain, - Field_Selected_Name, - Field_Type_Declarator, - Field_Enumeration_Literal_List, - Field_Entity_Class_Entry_Chain, - Field_Group_Constituent_List, - Field_Unit_Chain, - Field_Primary_Unit, - Field_Identifier, - Field_Label, - Field_Visible_Flag, - Field_Range_Constraint, - Field_Direction, - Field_Left_Limit, - Field_Right_Limit, - Field_Base_Type, - Field_Resolution_Indication, - Field_Record_Element_Resolution_Chain, - Field_Tolerance, - Field_Plus_Terminal, - Field_Minus_Terminal, - Field_Simultaneous_Left, - Field_Simultaneous_Right, - Field_Text_File_Flag, - Field_Only_Characters_Flag, - Field_Type_Staticness, - Field_Constraint_State, - Field_Index_Subtype_List, - Field_Index_Subtype_Definition_List, - Field_Element_Subtype_Indication, - Field_Element_Subtype, - Field_Index_Constraint_List, - Field_Array_Element_Constraint, - Field_Elements_Declaration_List, - Field_Designated_Type, - Field_Designated_Subtype_Indication, - Field_Index_List, - Field_Reference, - Field_Nature_Declarator, - Field_Across_Type, - Field_Through_Type, - Field_Target, - Field_Waveform_Chain, - Field_Guard, - Field_Delay_Mechanism, - Field_Reject_Time_Expression, - Field_Sensitivity_List, - Field_Process_Origin, - Field_Condition_Clause, - Field_Timeout_Clause, - Field_Postponed_Flag, - Field_Callees_List, - Field_Passive_Flag, - Field_Resolution_Function_Flag, - Field_Wait_State, - Field_All_Sensitized_State, - Field_Seen_Flag, - Field_Pure_Flag, - Field_Foreign_Flag, - Field_Resolved_Flag, - Field_Signal_Type_Flag, - Field_Has_Signal_Flag, - Field_Purity_State, - Field_Elab_Flag, - Field_Index_Constraint_Flag, - Field_Assertion_Condition, - Field_Report_Expression, - Field_Severity_Expression, - Field_Instantiated_Unit, - Field_Generic_Map_Aspect_Chain, - Field_Port_Map_Aspect_Chain, - Field_Configuration_Name, - Field_Component_Configuration, - Field_Configuration_Specification, - Field_Default_Binding_Indication, - Field_Default_Configuration_Declaration, - Field_Expression, - Field_Allocator_Designated_Type, - Field_Selected_Waveform_Chain, - Field_Conditional_Waveform_Chain, - Field_Guard_Expression, - Field_Guard_Decl, - Field_Guard_Sensitivity_List, - Field_Block_Block_Configuration, - Field_Package_Header, - Field_Block_Header, - Field_Uninstantiated_Package_Name, - Field_Generate_Block_Configuration, - Field_Generation_Scheme, - Field_Condition, - Field_Else_Clause, - Field_Parameter_Specification, - Field_Parent, - Field_Loop_Label, - Field_Component_Name, - Field_Instantiation_List, - Field_Entity_Aspect, - Field_Default_Entity_Aspect, - Field_Default_Generic_Map_Aspect_Chain, - Field_Default_Port_Map_Aspect_Chain, - Field_Binding_Indication, - Field_Named_Entity, - Field_Alias_Declaration, - Field_Expr_Staticness, - Field_Error_Origin, - Field_Operand, - Field_Left, - Field_Right, - Field_Unit_Name, - Field_Name, - Field_Group_Template_Name, - Field_Name_Staticness, - Field_Prefix, - Field_Signature_Prefix, - Field_Slice_Subtype, - Field_Suffix, - Field_Index_Subtype, - Field_Parameter, - Field_Actual_Type, - Field_Associated_Interface, - Field_Association_Chain, - Field_Individual_Association_Chain, - Field_Aggregate_Info, - Field_Sub_Aggregate_Info, - Field_Aggr_Dynamic_Flag, - Field_Aggr_Min_Length, - Field_Aggr_Low_Limit, - Field_Aggr_High_Limit, - Field_Aggr_Others_Flag, - Field_Aggr_Named_Flag, - Field_Value_Staticness, - Field_Association_Choices_Chain, - Field_Case_Statement_Alternative_Chain, - Field_Choice_Staticness, - Field_Procedure_Call, - Field_Implementation, - Field_Parameter_Association_Chain, - Field_Method_Object, - Field_Subtype_Type_Mark, - Field_Type_Conversion_Subtype, - Field_Type_Mark, - Field_File_Type_Mark, - Field_Return_Type_Mark, - Field_Lexical_Layout, - Field_Incomplete_Type_List, - Field_Has_Disconnect_Flag, - Field_Has_Active_Flag, - Field_Is_Within_Flag, - Field_Type_Marks_List, - Field_Implicit_Alias_Flag, - Field_Alias_Signature, - Field_Attribute_Signature, - Field_Overload_List, - Field_Simple_Name_Identifier, - Field_Simple_Name_Subtype, - Field_Protected_Type_Body, - Field_Protected_Type_Declaration, - Field_End_Location, - Field_String_Id, - Field_String_Length, - Field_Use_Flag, - Field_End_Has_Reserved_Id, - Field_End_Has_Identifier, - Field_End_Has_Postponed, - Field_Has_Begin, - Field_Has_Is, - Field_Has_Pure, - Field_Has_Body, - Field_Has_Identifier_List, - Field_Has_Mode, - Field_Is_Ref, - Field_Psl_Property, - Field_Psl_Declaration, - Field_Psl_Expression, - Field_Psl_Boolean, - Field_PSL_Clock, - Field_PSL_NFA - ); - pragma Discard_Names (Fields_Enum); - - -- Return the type of field F. - function Get_Field_Type (F : Fields_Enum) return Types_Enum; - - -- Get the name of a field. - function Get_Field_Image (F : Fields_Enum) return String; - - -- Get the name of a kind. - function Get_Iir_Image (K : Iir_Kind) return String; - - -- Possible attributes of a field. - type Field_Attribute is - ( - Attr_None, - Attr_Ref, Attr_Maybe_Ref, Attr_Of_Ref, - Attr_Chain, Attr_Chain_Next - ); - - -- Get the attribute of a field. - function Get_Field_Attribute (F : Fields_Enum) return Field_Attribute; - - type Fields_Array is array (Natural range <>) of Fields_Enum; - - -- Return the list of fields for node K. The fields are sorted: first - -- the non nodes/list of nodes, then the nodes/lists that aren't reference, - -- and then the reference. - function Get_Fields (K : Iir_Kind) return Fields_Array; - - -- Get/Set a field. - function Get_Base_Type - (N : Iir; F : Fields_Enum) return Base_Type; - procedure Set_Base_Type - (N : Iir; F : Fields_Enum; V: Base_Type); - - function Get_Boolean - (N : Iir; F : Fields_Enum) return Boolean; - procedure Set_Boolean - (N : Iir; F : Fields_Enum; V: Boolean); - - function Get_Date_State_Type - (N : Iir; F : Fields_Enum) return Date_State_Type; - procedure Set_Date_State_Type - (N : Iir; F : Fields_Enum; V: Date_State_Type); - - function Get_Date_Type - (N : Iir; F : Fields_Enum) return Date_Type; - procedure Set_Date_Type - (N : Iir; F : Fields_Enum; V: Date_Type); - - function Get_Iir - (N : Iir; F : Fields_Enum) return Iir; - procedure Set_Iir - (N : Iir; F : Fields_Enum; V: Iir); - - function Get_Iir_All_Sensitized - (N : Iir; F : Fields_Enum) return Iir_All_Sensitized; - procedure Set_Iir_All_Sensitized - (N : Iir; F : Fields_Enum; V: Iir_All_Sensitized); - - function Get_Iir_Constraint - (N : Iir; F : Fields_Enum) return Iir_Constraint; - procedure Set_Iir_Constraint - (N : Iir; F : Fields_Enum; V: Iir_Constraint); - - function Get_Iir_Delay_Mechanism - (N : Iir; F : Fields_Enum) return Iir_Delay_Mechanism; - procedure Set_Iir_Delay_Mechanism - (N : Iir; F : Fields_Enum; V: Iir_Delay_Mechanism); - - function Get_Iir_Direction - (N : Iir; F : Fields_Enum) return Iir_Direction; - procedure Set_Iir_Direction - (N : Iir; F : Fields_Enum; V: Iir_Direction); - - function Get_Iir_Fp64 - (N : Iir; F : Fields_Enum) return Iir_Fp64; - procedure Set_Iir_Fp64 - (N : Iir; F : Fields_Enum; V: Iir_Fp64); - - function Get_Iir_Index32 - (N : Iir; F : Fields_Enum) return Iir_Index32; - procedure Set_Iir_Index32 - (N : Iir; F : Fields_Enum; V: Iir_Index32); - - function Get_Iir_Int32 - (N : Iir; F : Fields_Enum) return Iir_Int32; - procedure Set_Iir_Int32 - (N : Iir; F : Fields_Enum; V: Iir_Int32); - - function Get_Iir_Int64 - (N : Iir; F : Fields_Enum) return Iir_Int64; - procedure Set_Iir_Int64 - (N : Iir; F : Fields_Enum; V: Iir_Int64); - - function Get_Iir_Lexical_Layout_Type - (N : Iir; F : Fields_Enum) return Iir_Lexical_Layout_Type; - procedure Set_Iir_Lexical_Layout_Type - (N : Iir; F : Fields_Enum; V: Iir_Lexical_Layout_Type); - - function Get_Iir_List - (N : Iir; F : Fields_Enum) return Iir_List; - procedure Set_Iir_List - (N : Iir; F : Fields_Enum; V: Iir_List); - - function Get_Iir_Mode - (N : Iir; F : Fields_Enum) return Iir_Mode; - procedure Set_Iir_Mode - (N : Iir; F : Fields_Enum; V: Iir_Mode); - - function Get_Iir_Predefined_Functions - (N : Iir; F : Fields_Enum) return Iir_Predefined_Functions; - procedure Set_Iir_Predefined_Functions - (N : Iir; F : Fields_Enum; V: Iir_Predefined_Functions); - - function Get_Iir_Pure_State - (N : Iir; F : Fields_Enum) return Iir_Pure_State; - procedure Set_Iir_Pure_State - (N : Iir; F : Fields_Enum; V: Iir_Pure_State); - - function Get_Iir_Signal_Kind - (N : Iir; F : Fields_Enum) return Iir_Signal_Kind; - procedure Set_Iir_Signal_Kind - (N : Iir; F : Fields_Enum; V: Iir_Signal_Kind); - - function Get_Iir_Staticness - (N : Iir; F : Fields_Enum) return Iir_Staticness; - procedure Set_Iir_Staticness - (N : Iir; F : Fields_Enum; V: Iir_Staticness); - - function Get_Int32 - (N : Iir; F : Fields_Enum) return Int32; - procedure Set_Int32 - (N : Iir; F : Fields_Enum; V: Int32); - - function Get_Location_Type - (N : Iir; F : Fields_Enum) return Location_Type; - procedure Set_Location_Type - (N : Iir; F : Fields_Enum; V: Location_Type); - - function Get_Name_Id - (N : Iir; F : Fields_Enum) return Name_Id; - procedure Set_Name_Id - (N : Iir; F : Fields_Enum; V: Name_Id); - - function Get_PSL_NFA - (N : Iir; F : Fields_Enum) return PSL_NFA; - procedure Set_PSL_NFA - (N : Iir; F : Fields_Enum; V: PSL_NFA); - - function Get_PSL_Node - (N : Iir; F : Fields_Enum) return PSL_Node; - procedure Set_PSL_Node - (N : Iir; F : Fields_Enum; V: PSL_Node); - - function Get_Source_Ptr - (N : Iir; F : Fields_Enum) return Source_Ptr; - procedure Set_Source_Ptr - (N : Iir; F : Fields_Enum; V: Source_Ptr); - - function Get_String_Id - (N : Iir; F : Fields_Enum) return String_Id; - procedure Set_String_Id - (N : Iir; F : Fields_Enum; V: String_Id); - - function Get_Time_Stamp_Id - (N : Iir; F : Fields_Enum) return Time_Stamp_Id; - procedure Set_Time_Stamp_Id - (N : Iir; F : Fields_Enum; V: Time_Stamp_Id); - - function Get_Token_Type - (N : Iir; F : Fields_Enum) return Token_Type; - procedure Set_Token_Type - (N : Iir; F : Fields_Enum; V: Token_Type); - - function Get_Tri_State_Type - (N : Iir; F : Fields_Enum) return Tri_State_Type; - procedure Set_Tri_State_Type - (N : Iir; F : Fields_Enum; V: Tri_State_Type); - - function Has_First_Design_Unit (K : Iir_Kind) return Boolean; - function Has_Last_Design_Unit (K : Iir_Kind) return Boolean; - function Has_Library_Declaration (K : Iir_Kind) return Boolean; - function Has_File_Time_Stamp (K : Iir_Kind) return Boolean; - function Has_Analysis_Time_Stamp (K : Iir_Kind) return Boolean; - function Has_Library (K : Iir_Kind) return Boolean; - function Has_File_Dependence_List (K : Iir_Kind) return Boolean; - function Has_Design_File_Filename (K : Iir_Kind) return Boolean; - function Has_Design_File_Directory (K : Iir_Kind) return Boolean; - function Has_Design_File (K : Iir_Kind) return Boolean; - function Has_Design_File_Chain (K : Iir_Kind) return Boolean; - function Has_Library_Directory (K : Iir_Kind) return Boolean; - function Has_Date (K : Iir_Kind) return Boolean; - function Has_Context_Items (K : Iir_Kind) return Boolean; - function Has_Dependence_List (K : Iir_Kind) return Boolean; - function Has_Analysis_Checks_List (K : Iir_Kind) return Boolean; - function Has_Date_State (K : Iir_Kind) return Boolean; - function Has_Guarded_Target_State (K : Iir_Kind) return Boolean; - function Has_Library_Unit (K : Iir_Kind) return Boolean; - function Has_Hash_Chain (K : Iir_Kind) return Boolean; - function Has_Design_Unit_Source_Pos (K : Iir_Kind) return Boolean; - function Has_Design_Unit_Source_Line (K : Iir_Kind) return Boolean; - function Has_Design_Unit_Source_Col (K : Iir_Kind) return Boolean; - function Has_Value (K : Iir_Kind) return Boolean; - function Has_Enum_Pos (K : Iir_Kind) return Boolean; - function Has_Physical_Literal (K : Iir_Kind) return Boolean; - function Has_Physical_Unit_Value (K : Iir_Kind) return Boolean; - function Has_Fp_Value (K : Iir_Kind) return Boolean; - function Has_Enumeration_Decl (K : Iir_Kind) return Boolean; - function Has_Simple_Aggregate_List (K : Iir_Kind) return Boolean; - function Has_Bit_String_Base (K : Iir_Kind) return Boolean; - function Has_Bit_String_0 (K : Iir_Kind) return Boolean; - function Has_Bit_String_1 (K : Iir_Kind) return Boolean; - function Has_Literal_Origin (K : Iir_Kind) return Boolean; - function Has_Range_Origin (K : Iir_Kind) return Boolean; - function Has_Literal_Subtype (K : Iir_Kind) return Boolean; - function Has_Entity_Class (K : Iir_Kind) return Boolean; - function Has_Entity_Name_List (K : Iir_Kind) return Boolean; - function Has_Attribute_Designator (K : Iir_Kind) return Boolean; - function Has_Attribute_Specification_Chain (K : Iir_Kind) - return Boolean; - function Has_Attribute_Specification (K : Iir_Kind) return Boolean; - function Has_Signal_List (K : Iir_Kind) return Boolean; - function Has_Designated_Entity (K : Iir_Kind) return Boolean; - function Has_Formal (K : Iir_Kind) return Boolean; - function Has_Actual (K : Iir_Kind) return Boolean; - function Has_In_Conversion (K : Iir_Kind) return Boolean; - function Has_Out_Conversion (K : Iir_Kind) return Boolean; - function Has_Whole_Association_Flag (K : Iir_Kind) return Boolean; - function Has_Collapse_Signal_Flag (K : Iir_Kind) return Boolean; - function Has_Artificial_Flag (K : Iir_Kind) return Boolean; - function Has_Open_Flag (K : Iir_Kind) return Boolean; - function Has_After_Drivers_Flag (K : Iir_Kind) return Boolean; - function Has_We_Value (K : Iir_Kind) return Boolean; - function Has_Time (K : Iir_Kind) return Boolean; - function Has_Associated_Expr (K : Iir_Kind) return Boolean; - function Has_Associated_Chain (K : Iir_Kind) return Boolean; - function Has_Choice_Name (K : Iir_Kind) return Boolean; - function Has_Choice_Expression (K : Iir_Kind) return Boolean; - function Has_Choice_Range (K : Iir_Kind) return Boolean; - function Has_Same_Alternative_Flag (K : Iir_Kind) return Boolean; - function Has_Architecture (K : Iir_Kind) return Boolean; - function Has_Block_Specification (K : Iir_Kind) return Boolean; - function Has_Prev_Block_Configuration (K : Iir_Kind) return Boolean; - function Has_Configuration_Item_Chain (K : Iir_Kind) return Boolean; - function Has_Attribute_Value_Chain (K : Iir_Kind) return Boolean; - function Has_Spec_Chain (K : Iir_Kind) return Boolean; - function Has_Attribute_Value_Spec_Chain (K : Iir_Kind) return Boolean; - function Has_Entity_Name (K : Iir_Kind) return Boolean; - function Has_Package (K : Iir_Kind) return Boolean; - function Has_Package_Body (K : Iir_Kind) return Boolean; - function Has_Need_Body (K : Iir_Kind) return Boolean; - function Has_Block_Configuration (K : Iir_Kind) return Boolean; - function Has_Concurrent_Statement_Chain (K : Iir_Kind) return Boolean; - function Has_Chain (K : Iir_Kind) return Boolean; - function Has_Port_Chain (K : Iir_Kind) return Boolean; - function Has_Generic_Chain (K : Iir_Kind) return Boolean; - function Has_Type (K : Iir_Kind) return Boolean; - function Has_Subtype_Indication (K : Iir_Kind) return Boolean; - function Has_Discrete_Range (K : Iir_Kind) return Boolean; - function Has_Type_Definition (K : Iir_Kind) return Boolean; - function Has_Subtype_Definition (K : Iir_Kind) return Boolean; - function Has_Nature (K : Iir_Kind) return Boolean; - function Has_Mode (K : Iir_Kind) return Boolean; - function Has_Signal_Kind (K : Iir_Kind) return Boolean; - function Has_Base_Name (K : Iir_Kind) return Boolean; - function Has_Interface_Declaration_Chain (K : Iir_Kind) return Boolean; - function Has_Subprogram_Specification (K : Iir_Kind) return Boolean; - function Has_Sequential_Statement_Chain (K : Iir_Kind) return Boolean; - function Has_Subprogram_Body (K : Iir_Kind) return Boolean; - function Has_Overload_Number (K : Iir_Kind) return Boolean; - function Has_Subprogram_Depth (K : Iir_Kind) return Boolean; - function Has_Subprogram_Hash (K : Iir_Kind) return Boolean; - function Has_Impure_Depth (K : Iir_Kind) return Boolean; - function Has_Return_Type (K : Iir_Kind) return Boolean; - function Has_Implicit_Definition (K : Iir_Kind) return Boolean; - function Has_Type_Reference (K : Iir_Kind) return Boolean; - function Has_Default_Value (K : Iir_Kind) return Boolean; - function Has_Deferred_Declaration (K : Iir_Kind) return Boolean; - function Has_Deferred_Declaration_Flag (K : Iir_Kind) return Boolean; - function Has_Shared_Flag (K : Iir_Kind) return Boolean; - function Has_Design_Unit (K : Iir_Kind) return Boolean; - function Has_Block_Statement (K : Iir_Kind) return Boolean; - function Has_Signal_Driver (K : Iir_Kind) return Boolean; - function Has_Declaration_Chain (K : Iir_Kind) return Boolean; - function Has_File_Logical_Name (K : Iir_Kind) return Boolean; - function Has_File_Open_Kind (K : Iir_Kind) return Boolean; - function Has_Element_Position (K : Iir_Kind) return Boolean; - function Has_Element_Declaration (K : Iir_Kind) return Boolean; - function Has_Selected_Element (K : Iir_Kind) return Boolean; - function Has_Use_Clause_Chain (K : Iir_Kind) return Boolean; - function Has_Selected_Name (K : Iir_Kind) return Boolean; - function Has_Type_Declarator (K : Iir_Kind) return Boolean; - function Has_Enumeration_Literal_List (K : Iir_Kind) return Boolean; - function Has_Entity_Class_Entry_Chain (K : Iir_Kind) return Boolean; - function Has_Group_Constituent_List (K : Iir_Kind) return Boolean; - function Has_Unit_Chain (K : Iir_Kind) return Boolean; - function Has_Primary_Unit (K : Iir_Kind) return Boolean; - function Has_Identifier (K : Iir_Kind) return Boolean; - function Has_Label (K : Iir_Kind) return Boolean; - function Has_Visible_Flag (K : Iir_Kind) return Boolean; - function Has_Range_Constraint (K : Iir_Kind) return Boolean; - function Has_Direction (K : Iir_Kind) return Boolean; - function Has_Left_Limit (K : Iir_Kind) return Boolean; - function Has_Right_Limit (K : Iir_Kind) return Boolean; - function Has_Base_Type (K : Iir_Kind) return Boolean; - function Has_Resolution_Indication (K : Iir_Kind) return Boolean; - function Has_Record_Element_Resolution_Chain (K : Iir_Kind) - return Boolean; - function Has_Tolerance (K : Iir_Kind) return Boolean; - function Has_Plus_Terminal (K : Iir_Kind) return Boolean; - function Has_Minus_Terminal (K : Iir_Kind) return Boolean; - function Has_Simultaneous_Left (K : Iir_Kind) return Boolean; - function Has_Simultaneous_Right (K : Iir_Kind) return Boolean; - function Has_Text_File_Flag (K : Iir_Kind) return Boolean; - function Has_Only_Characters_Flag (K : Iir_Kind) return Boolean; - function Has_Type_Staticness (K : Iir_Kind) return Boolean; - function Has_Constraint_State (K : Iir_Kind) return Boolean; - function Has_Index_Subtype_List (K : Iir_Kind) return Boolean; - function Has_Index_Subtype_Definition_List (K : Iir_Kind) - return Boolean; - function Has_Element_Subtype_Indication (K : Iir_Kind) return Boolean; - function Has_Element_Subtype (K : Iir_Kind) return Boolean; - function Has_Index_Constraint_List (K : Iir_Kind) return Boolean; - function Has_Array_Element_Constraint (K : Iir_Kind) return Boolean; - function Has_Elements_Declaration_List (K : Iir_Kind) return Boolean; - function Has_Designated_Type (K : Iir_Kind) return Boolean; - function Has_Designated_Subtype_Indication (K : Iir_Kind) - return Boolean; - function Has_Index_List (K : Iir_Kind) return Boolean; - function Has_Reference (K : Iir_Kind) return Boolean; - function Has_Nature_Declarator (K : Iir_Kind) return Boolean; - function Has_Across_Type (K : Iir_Kind) return Boolean; - function Has_Through_Type (K : Iir_Kind) return Boolean; - function Has_Target (K : Iir_Kind) return Boolean; - function Has_Waveform_Chain (K : Iir_Kind) return Boolean; - function Has_Guard (K : Iir_Kind) return Boolean; - function Has_Delay_Mechanism (K : Iir_Kind) return Boolean; - function Has_Reject_Time_Expression (K : Iir_Kind) return Boolean; - function Has_Sensitivity_List (K : Iir_Kind) return Boolean; - function Has_Process_Origin (K : Iir_Kind) return Boolean; - function Has_Condition_Clause (K : Iir_Kind) return Boolean; - function Has_Timeout_Clause (K : Iir_Kind) return Boolean; - function Has_Postponed_Flag (K : Iir_Kind) return Boolean; - function Has_Callees_List (K : Iir_Kind) return Boolean; - function Has_Passive_Flag (K : Iir_Kind) return Boolean; - function Has_Resolution_Function_Flag (K : Iir_Kind) return Boolean; - function Has_Wait_State (K : Iir_Kind) return Boolean; - function Has_All_Sensitized_State (K : Iir_Kind) return Boolean; - function Has_Seen_Flag (K : Iir_Kind) return Boolean; - function Has_Pure_Flag (K : Iir_Kind) return Boolean; - function Has_Foreign_Flag (K : Iir_Kind) return Boolean; - function Has_Resolved_Flag (K : Iir_Kind) return Boolean; - function Has_Signal_Type_Flag (K : Iir_Kind) return Boolean; - function Has_Has_Signal_Flag (K : Iir_Kind) return Boolean; - function Has_Purity_State (K : Iir_Kind) return Boolean; - function Has_Elab_Flag (K : Iir_Kind) return Boolean; - function Has_Index_Constraint_Flag (K : Iir_Kind) return Boolean; - function Has_Assertion_Condition (K : Iir_Kind) return Boolean; - function Has_Report_Expression (K : Iir_Kind) return Boolean; - function Has_Severity_Expression (K : Iir_Kind) return Boolean; - function Has_Instantiated_Unit (K : Iir_Kind) return Boolean; - function Has_Generic_Map_Aspect_Chain (K : Iir_Kind) return Boolean; - function Has_Port_Map_Aspect_Chain (K : Iir_Kind) return Boolean; - function Has_Configuration_Name (K : Iir_Kind) return Boolean; - function Has_Component_Configuration (K : Iir_Kind) return Boolean; - function Has_Configuration_Specification (K : Iir_Kind) return Boolean; - function Has_Default_Binding_Indication (K : Iir_Kind) return Boolean; - function Has_Default_Configuration_Declaration (K : Iir_Kind) - return Boolean; - function Has_Expression (K : Iir_Kind) return Boolean; - function Has_Allocator_Designated_Type (K : Iir_Kind) return Boolean; - function Has_Selected_Waveform_Chain (K : Iir_Kind) return Boolean; - function Has_Conditional_Waveform_Chain (K : Iir_Kind) return Boolean; - function Has_Guard_Expression (K : Iir_Kind) return Boolean; - function Has_Guard_Decl (K : Iir_Kind) return Boolean; - function Has_Guard_Sensitivity_List (K : Iir_Kind) return Boolean; - function Has_Block_Block_Configuration (K : Iir_Kind) return Boolean; - function Has_Package_Header (K : Iir_Kind) return Boolean; - function Has_Block_Header (K : Iir_Kind) return Boolean; - function Has_Uninstantiated_Package_Name (K : Iir_Kind) return Boolean; - function Has_Generate_Block_Configuration (K : Iir_Kind) return Boolean; - function Has_Generation_Scheme (K : Iir_Kind) return Boolean; - function Has_Condition (K : Iir_Kind) return Boolean; - function Has_Else_Clause (K : Iir_Kind) return Boolean; - function Has_Parameter_Specification (K : Iir_Kind) return Boolean; - function Has_Parent (K : Iir_Kind) return Boolean; - function Has_Loop_Label (K : Iir_Kind) return Boolean; - function Has_Component_Name (K : Iir_Kind) return Boolean; - function Has_Instantiation_List (K : Iir_Kind) return Boolean; - function Has_Entity_Aspect (K : Iir_Kind) return Boolean; - function Has_Default_Entity_Aspect (K : Iir_Kind) return Boolean; - function Has_Default_Generic_Map_Aspect_Chain (K : Iir_Kind) - return Boolean; - function Has_Default_Port_Map_Aspect_Chain (K : Iir_Kind) - return Boolean; - function Has_Binding_Indication (K : Iir_Kind) return Boolean; - function Has_Named_Entity (K : Iir_Kind) return Boolean; - function Has_Alias_Declaration (K : Iir_Kind) return Boolean; - function Has_Expr_Staticness (K : Iir_Kind) return Boolean; - function Has_Error_Origin (K : Iir_Kind) return Boolean; - function Has_Operand (K : Iir_Kind) return Boolean; - function Has_Left (K : Iir_Kind) return Boolean; - function Has_Right (K : Iir_Kind) return Boolean; - function Has_Unit_Name (K : Iir_Kind) return Boolean; - function Has_Name (K : Iir_Kind) return Boolean; - function Has_Group_Template_Name (K : Iir_Kind) return Boolean; - function Has_Name_Staticness (K : Iir_Kind) return Boolean; - function Has_Prefix (K : Iir_Kind) return Boolean; - function Has_Signature_Prefix (K : Iir_Kind) return Boolean; - function Has_Slice_Subtype (K : Iir_Kind) return Boolean; - function Has_Suffix (K : Iir_Kind) return Boolean; - function Has_Index_Subtype (K : Iir_Kind) return Boolean; - function Has_Parameter (K : Iir_Kind) return Boolean; - function Has_Actual_Type (K : Iir_Kind) return Boolean; - function Has_Associated_Interface (K : Iir_Kind) return Boolean; - function Has_Association_Chain (K : Iir_Kind) return Boolean; - function Has_Individual_Association_Chain (K : Iir_Kind) return Boolean; - function Has_Aggregate_Info (K : Iir_Kind) return Boolean; - function Has_Sub_Aggregate_Info (K : Iir_Kind) return Boolean; - function Has_Aggr_Dynamic_Flag (K : Iir_Kind) return Boolean; - function Has_Aggr_Min_Length (K : Iir_Kind) return Boolean; - function Has_Aggr_Low_Limit (K : Iir_Kind) return Boolean; - function Has_Aggr_High_Limit (K : Iir_Kind) return Boolean; - function Has_Aggr_Others_Flag (K : Iir_Kind) return Boolean; - function Has_Aggr_Named_Flag (K : Iir_Kind) return Boolean; - function Has_Value_Staticness (K : Iir_Kind) return Boolean; - function Has_Association_Choices_Chain (K : Iir_Kind) return Boolean; - function Has_Case_Statement_Alternative_Chain (K : Iir_Kind) - return Boolean; - function Has_Choice_Staticness (K : Iir_Kind) return Boolean; - function Has_Procedure_Call (K : Iir_Kind) return Boolean; - function Has_Implementation (K : Iir_Kind) return Boolean; - function Has_Parameter_Association_Chain (K : Iir_Kind) return Boolean; - function Has_Method_Object (K : Iir_Kind) return Boolean; - function Has_Subtype_Type_Mark (K : Iir_Kind) return Boolean; - function Has_Type_Conversion_Subtype (K : Iir_Kind) return Boolean; - function Has_Type_Mark (K : Iir_Kind) return Boolean; - function Has_File_Type_Mark (K : Iir_Kind) return Boolean; - function Has_Return_Type_Mark (K : Iir_Kind) return Boolean; - function Has_Lexical_Layout (K : Iir_Kind) return Boolean; - function Has_Incomplete_Type_List (K : Iir_Kind) return Boolean; - function Has_Has_Disconnect_Flag (K : Iir_Kind) return Boolean; - function Has_Has_Active_Flag (K : Iir_Kind) return Boolean; - function Has_Is_Within_Flag (K : Iir_Kind) return Boolean; - function Has_Type_Marks_List (K : Iir_Kind) return Boolean; - function Has_Implicit_Alias_Flag (K : Iir_Kind) return Boolean; - function Has_Alias_Signature (K : Iir_Kind) return Boolean; - function Has_Attribute_Signature (K : Iir_Kind) return Boolean; - function Has_Overload_List (K : Iir_Kind) return Boolean; - function Has_Simple_Name_Identifier (K : Iir_Kind) return Boolean; - function Has_Simple_Name_Subtype (K : Iir_Kind) return Boolean; - function Has_Protected_Type_Body (K : Iir_Kind) return Boolean; - function Has_Protected_Type_Declaration (K : Iir_Kind) return Boolean; - function Has_End_Location (K : Iir_Kind) return Boolean; - function Has_String_Id (K : Iir_Kind) return Boolean; - function Has_String_Length (K : Iir_Kind) return Boolean; - function Has_Use_Flag (K : Iir_Kind) return Boolean; - function Has_End_Has_Reserved_Id (K : Iir_Kind) return Boolean; - function Has_End_Has_Identifier (K : Iir_Kind) return Boolean; - function Has_End_Has_Postponed (K : Iir_Kind) return Boolean; - function Has_Has_Begin (K : Iir_Kind) return Boolean; - function Has_Has_Is (K : Iir_Kind) return Boolean; - function Has_Has_Pure (K : Iir_Kind) return Boolean; - function Has_Has_Body (K : Iir_Kind) return Boolean; - function Has_Has_Identifier_List (K : Iir_Kind) return Boolean; - function Has_Has_Mode (K : Iir_Kind) return Boolean; - function Has_Is_Ref (K : Iir_Kind) return Boolean; - function Has_Psl_Property (K : Iir_Kind) return Boolean; - function Has_Psl_Declaration (K : Iir_Kind) return Boolean; - function Has_Psl_Expression (K : Iir_Kind) return Boolean; - function Has_Psl_Boolean (K : Iir_Kind) return Boolean; - function Has_PSL_Clock (K : Iir_Kind) return Boolean; - function Has_PSL_NFA (K : Iir_Kind) return Boolean; -end Nodes_Meta; diff --git a/nodes_meta.ads.in b/nodes_meta.ads.in deleted file mode 100644 index 8e1dceca9..000000000 --- a/nodes_meta.ads.in +++ /dev/null @@ -1,66 +0,0 @@ --- Meta description of nodes. --- Copyright (C) 2014 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Types; use Types; -with Iirs; use Iirs; -with Tokens; use Tokens; - -package Nodes_Meta is - -- The enumeration of all possible types in the nodes. - type Types_Enum is - ( - -- TYPES - ); - - -- The enumeration of all fields defined in iirs. - type Fields_Enum is - ( - -- FIELDS - ); - pragma Discard_Names (Fields_Enum); - - -- Return the type of field F. - function Get_Field_Type (F : Fields_Enum) return Types_Enum; - - -- Get the name of a field. - function Get_Field_Image (F : Fields_Enum) return String; - - -- Get the name of a kind. - function Get_Iir_Image (K : Iir_Kind) return String; - - -- Possible attributes of a field. - type Field_Attribute is - ( - Attr_None, - Attr_Ref, Attr_Maybe_Ref, Attr_Of_Ref, - Attr_Chain, Attr_Chain_Next - ); - - -- Get the attribute of a field. - function Get_Field_Attribute (F : Fields_Enum) return Field_Attribute; - - type Fields_Array is array (Natural range <>) of Fields_Enum; - - -- Return the list of fields for node K. The fields are sorted: first - -- the non nodes/list of nodes, then the nodes/lists that aren't reference, - -- and then the reference. - function Get_Fields (K : Iir_Kind) return Fields_Array; - - -- Get/Set a field. - -- FUNCS -end Nodes_Meta; diff --git a/options.adb b/options.adb deleted file mode 100644 index 7af0804a4..000000000 --- a/options.adb +++ /dev/null @@ -1,242 +0,0 @@ --- Command line options. --- Copyright (C) 2008 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Ada.Text_IO; use Ada.Text_IO; -with Name_Table; -with Libraries; -with Std_Names; -with PSL.Nodes; -with PSL.Dump_Tree; -with Disp_Tree; -with Scanner; -with Back_End; use Back_End; -with Flags; use Flags; - -package body Options is - procedure Initialize is - begin - Std_Names.Std_Names_Initialize; - Libraries.Init_Pathes; - PSL.Nodes.Init; - PSL.Dump_Tree.Dump_Hdl_Node := Disp_Tree.Disp_Tree_For_Psl'Access; - end Initialize; - - function Option_Warning (Opt: String; Val : Boolean) return Boolean is - begin --- if Opt = "undriven" then --- Warn_Undriven := True; - if Opt = "library" then - Warn_Library := Val; - elsif Opt = "default-binding" then - Warn_Default_Binding := Val; - elsif Opt = "binding" then - Warn_Binding := Val; - elsif Opt = "reserved" then - Warn_Reserved_Word := Val; - elsif Opt = "vital-generic" then - Warn_Vital_Generic := Val; - elsif Opt = "delayed-checks" then - Warn_Delayed_Checks := Val; - elsif Opt = "body" then - Warn_Body := Val; - elsif Opt = "specs" then - Warn_Specs := Val; - elsif Opt = "unused" then - Warn_Unused := Val; - elsif Opt = "error" then - Warn_Error := Val; - else - return False; - end if; - return True; - end Option_Warning; - - function Parse_Option (Opt: String) return Boolean - is - Beg: constant Integer := Opt'First; - begin - if Opt'Length > 5 and then Opt (Beg .. Beg + 5) = "--std=" then - if Opt'Length = 8 then - if Opt (Beg + 6 .. Beg + 7) = "87" then - Vhdl_Std := Vhdl_87; - elsif Opt (Beg + 6 .. Beg + 7) = "93" then - Vhdl_Std := Vhdl_93; - elsif Opt (Beg + 6 .. Beg + 7) = "00" then - Vhdl_Std := Vhdl_00; - elsif Opt (Beg + 6 .. Beg + 7) = "02" then - Vhdl_Std := Vhdl_02; - elsif Opt (Beg + 6 .. Beg + 7) = "08" then - Vhdl_Std := Vhdl_08; - else - return False; - end if; - elsif Opt'Length = 9 and then Opt (Beg + 6 .. Beg + 8) = "93c" then - Vhdl_Std := Vhdl_93c; - else - return False; - end if; - elsif Opt'Length = 5 and then Opt (Beg .. Beg + 4) = "--ams" then - AMS_Vhdl := True; - elsif Opt'Length > 2 and then Opt (Beg .. Beg + 1) = "-P" then - Libraries.Add_Library_Path (Opt (Beg + 2 .. Opt'Last)); - elsif Opt'Length > 10 and then Opt (Beg .. Beg + 9) = "--workdir=" then - Libraries.Set_Work_Library_Path (Opt (Beg + 10 .. Opt'Last)); - elsif Opt'Length > 10 and then Opt (Beg .. Beg + 9) = "--warn-no-" then - return Option_Warning (Opt (Beg + 10 .. Opt'Last), False); - elsif Opt'Length > 7 and then Opt (Beg .. Beg + 6) = "--warn-" then - return Option_Warning (Opt (Beg + 7 .. Opt'Last), True); - elsif Opt'Length > 7 and then Opt (Beg .. Beg + 6) = "--work=" then - declare - use Name_Table; - begin - Name_Length := Opt'Last - (Beg + 7) + 1; - Name_Buffer (1 .. Name_Length) := Opt (Beg + 7 .. Opt'Last); - Scanner.Convert_Identifier; - Libraries.Work_Library_Name := Get_Identifier; - end; - elsif Opt = "-C" or else Opt = "--mb-comments" then - Mb_Comment := True; - elsif Opt = "--bootstrap" then - Bootstrap := True; - elsif Opt = "-fexplicit" then - Flag_Explicit := True; - elsif Opt = "-frelaxed-rules" then - Flag_Relaxed_Rules := True; - elsif Opt = "--syn-binding" then - Flag_Syn_Binding := True; - elsif Opt = "--no-vital-checks" then - Flag_Vital_Checks := False; - elsif Opt = "--vital-checks" then - Flag_Vital_Checks := True; - elsif Opt = "-fpsl" then - Scanner.Flag_Psl_Comment := True; - Scanner.Flag_Comment_Keyword := True; - elsif Opt = "-dp" then - Dump_Parse := True; - elsif Opt = "-ds" then - Dump_Sem := True; - elsif Opt = "-dc" then - Dump_Canon := True; - elsif Opt = "-da" then - Dump_Annotate := True; - elsif Opt = "--dall" then - Dump_All := True; - elsif Opt = "-dstats" then - Dump_Stats := True; - elsif Opt = "--lall" then - List_All := True; - elsif Opt = "-lv" then - List_Verbose := True; - elsif Opt = "-ls" then - List_Sem := True; - elsif Opt = "-lc" then - List_Canon := True; - elsif Opt = "-la" then - List_Annotate := True; - elsif Opt = "-v" then - Verbose := True; - elsif Opt = "--finteger64" then - Flag_Integer_64 := True; - elsif Opt = "--ftime32" then - Flag_Time_64 := False; --- elsif Opt'Length > 17 --- and then Opt (Beg .. Beg + 17) = "--time-resolution=" --- then --- Beg := Beg + 18; --- if Opt (Beg .. Beg + 1) = "fs" then --- Time_Resolution := 'f'; --- elsif Opt (Beg .. Beg + 1) = "ps" then --- Time_Resolution := 'p'; --- elsif Opt (Beg .. Beg + 1) = "ns" then --- Time_Resolution := 'n'; --- elsif Opt (Beg .. Beg + 1) = "us" then --- Time_Resolution := 'u'; --- elsif Opt (Beg .. Beg + 1) = "ms" then --- Time_Resolution := 'm'; --- elsif Opt (Beg .. Beg + 2) = "sec" then --- Time_Resolution := 's'; --- elsif Opt (Beg .. Beg + 2) = "min" then --- Time_Resolution := 'M'; --- elsif Opt (Beg .. Beg + 1) = "hr" then --- Time_Resolution := 'h'; --- else --- return False; --- end if; - elsif Back_End.Parse_Option /= null - and then Back_End.Parse_Option.all (Opt) - then - null; - else - return False; - end if; - return True; - end Parse_Option; - - -- Disp help about these options. - procedure Disp_Options_Help - is - procedure P (S : String) renames Put_Line; - begin - P ("Main options:"); - P (" --work=LIB use LIB as work library"); - P (" --workdir=DIR use DIR for the file library"); - P (" -PPATH add PATH in the library path list"); - P (" --std=87/93/00/02/08 select vhdl 87/93/00/02/08 standard"); - P (" --std=93c select vhdl 93 standard and allow 87 syntax"); - P (" --[no-]vital-checks do [not] check VITAL restrictions"); - P ("Warnings:"); --- P (" --warn-undriven disp undriven signals"); - P (" --warn-binding warns for component not bound"); - P (" --warn-reserved warns use of 93 reserved words in vhdl87"); - P (" --warn-library warns for redefinition of a design unit"); - P (" --warn-vital-generic warns of non-vital generic names"); - P (" --warn-delayed-checks warns for checks performed at elaboration"); - P (" --warn-body warns for not necessary package body"); - P (" --warn-specs warns if a all/others spec does not apply"); - P (" --warn-unused warns if a subprogram is never used"); - P (" --warn-error turns warnings into errors"); --- P ("Simulation option:"); --- P (" --time-resolution=UNIT set the resolution of type time"); --- P (" UNIT can be fs, ps, ns, us, ms, sec, min or hr"); --- P (" --assert-level=LEVEL set the level which stop the"); --- P (" simulation. LEVEL is note, warning, error,"); --- P (" failure or none"); - P ("Extensions:"); - P (" -fexplicit give priority to explicitly declared operator"); - P (" -frelaxed-rules relax some LRM rules"); - P (" -C --mb-comments allow multi-bytes chars in a comment"); - P (" --bootstrap allow --work=std"); - P (" --syn-binding use synthesis default binding rule"); - P (" -fpsl parse psl in comments"); - P ("Compilation list:"); - P (" -ls after semantics"); - P (" -lc after canon"); - P (" -la after annotation"); - P (" --lall -lX options apply to all files"); - P (" -lv verbose list"); - P (" -v disp compilation stages"); - P ("Compilation dump:"); - P (" -dp dump tree after parsing"); - P (" -ds dump tree after semantics"); - P (" -da dump tree after annotate"); - P (" --dall -dX options apply to all files"); - if Back_End.Disp_Option /= null then - Back_End.Disp_Option.all; - end if; - end Disp_Options_Help; - -end Options; diff --git a/options.ads b/options.ads deleted file mode 100644 index 24a844b59..000000000 --- a/options.ads +++ /dev/null @@ -1,30 +0,0 @@ --- Command line options. --- Copyright (C) 2008 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -package Options is - -- Return true if opt is recognize by flags. - -- Note: std_names.std_names_initialize and files_map.init_pathes must have - -- been called before this subprogram. - function Parse_Option (Opt: String) return Boolean; - - -- Disp help about these options. - procedure Disp_Options_Help; - - -- Front-end intialization. - procedure Initialize; -end Options; diff --git a/ortho/Makefile.inc b/ortho/Makefile.inc deleted file mode 100644 index 597aaeff1..000000000 --- a/ortho/Makefile.inc +++ /dev/null @@ -1,38 +0,0 @@ -# Common -*- Makefile -*- for ortho implementations. -# Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold -# -# GHDL 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 2, or (at your option) any later -# version. -# -# GHDL 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 GCC; see the file COPYING. If not, write to the Free -# Software Foundation, 59 Temple Place - Suite 330, Boston, MA -# 02111-1307, USA. - -# Variable to be defined: -# SED: sed the stream editor -# ORTHO_BASENAME - -$(ortho_srcdir)/$(BE)/$(ORTHO_BASENAME).ads: \ - $(ortho_srcdir)/ortho_nodes.common.ads \ - $(ortho_srcdir)/$(BE)/$(ORTHO_BASENAME).private.ads - $(RM) -f $@ - echo "-- DO NOT MODIFY - this file was generated from:" > $@ - echo "-- ortho_nodes.common.ads and $(ORTHO_BASENAME).private.ads" \ - >> $@ - echo "--" >> $@ - $(SED) -e '/^private/,$$d' \ - < $(ortho_srcdir)/$(BE)/$(ORTHO_BASENAME).private.ads >> $@ - echo "-- Start of common part" >> $@ - $(SED) -e '1,/^package/d' -e '/^private/,$$d' < $< >> $@ - echo "-- End of common part" >> $@ - $(SED) -n -e '/^private/,$$p' \ - < $(ortho_srcdir)/$(BE)/$(ORTHO_BASENAME).private.ads >> $@ - chmod a-w $@ diff --git a/ortho/debug/Makefile b/ortho/debug/Makefile deleted file mode 100644 index 0c15111ef..000000000 --- a/ortho/debug/Makefile +++ /dev/null @@ -1,47 +0,0 @@ -# -*- Makefile -*- for the ortho-code back-end -# Copyright (C) 2005 Tristan Gingold -# -# GHDL 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 2, or (at your option) any later -# version. -# -# GHDL 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 GCC; see the file COPYING. If not, write to the Free -# Software Foundation, 59 Temple Place - Suite 330, Boston, MA -# 02111-1307, USA. -BE=debug -ortho_srcdir=.. - -orthobe_srcdir=$(ortho_srcdir)/$(BE) - -GNATMAKE=gnatmake -CC=gcc -CFLAGS=-g -ALL_GNAT_FLAGS=-pipe -g -gnato -gnatwl -gnatf -gnaty3befhkmr -gnatwu -GNATMAKE_FLAGS=-m $(ALL_GNAT_FLAGS) $(GNAT_FLAGS) -aI$(ortho_srcdir) -aI$(orthobe_srcdir) -aI. -#LARGS=-largs -static -SED=sed - -all: $(ortho_exec) - - -$(ortho_exec): force $(ortho_srcdir)/$(BE)/ortho_debug.ads - gnatmake -o $@ $(GNATMAKE_FLAGS) ortho_debug-main -bargs -E $(LARGS) - -clean: - $(RM) -f *.o *.ali *~ b~*.ad? ortho_nodes-main - $(RM) ortho_debug.ads - -force: - -ORTHO_BASENAME=ortho_debug - -# Automatically build ortho_debug.ads from ortho_node.common.ads and -# ortho_debug.private.ads -include $(ortho_srcdir)/Makefile.inc diff --git a/ortho/debug/ortho_debug-disp.adb b/ortho/debug/ortho_debug-disp.adb deleted file mode 100644 index 2725668bb..000000000 --- a/ortho/debug/ortho_debug-disp.adb +++ /dev/null @@ -1,1064 +0,0 @@ --- Display the code from the ortho debug tree. --- Copyright (C) 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GCC; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -package body Ortho_Debug.Disp is - Disp_All_Types : constant Boolean := False; - - package Formated_Output is - use Interfaces.C_Streams; - - type Disp_Context is limited private; - - procedure Init_Context (File : FILEs); - - -- Save the current context, and create a new one. - procedure Push_Context (File : FILEs; Prev_Ctx : out Disp_Context); - - -- Restore a previous context, saved by Push_Context. - procedure Pop_Context (Prev_Ctx : Disp_Context); - - procedure Put (Str : String); - - procedure Put_Line (Str : String); - - -- Add a tabulation. - -- Every new line will start at this tabulation. - procedure Add_Tab; - - -- Removed a tabulation. - -- The next new line will start at the previous tabulation. - procedure Rem_Tab; - - -- Flush the current output. - procedure Flush; - - -- Return TRUE if the ident level is nul. - function Is_Top return Boolean; - - procedure Put_Tab; - - procedure New_Line; - - procedure Put (C : Character); - - procedure Put_Trim (Str : String); - - procedure Set_Mark; - - -- Flush to disk. Only for debugging in case of crash. - procedure Flush_File; - pragma Unreferenced (Flush_File); - private - type Disp_Context is record - -- File where the info are written to. - File : FILEs; - -- Line number of the line to be written. - Lineno : Natural; - -- Buffer for the current line. - Line : String (1 .. 256); - -- Number of characters currently in the line. - Line_Len : Natural; - - -- Current tabulation. - Tab : Natural; - -- Tabulation to be used for the next line. - Next_Tab : Natural; - - Mark : Natural; - end record; - end Formated_Output; - - package body Formated_Output is - -- The current context. - Ctx : Disp_Context; - - procedure Init_Context (File : FILEs) is - begin - Ctx.File := File; - Ctx.Lineno := 1; - Ctx.Line_Len := 0; - Ctx.Tab := 0; - Ctx.Next_Tab := 0; - Ctx.Mark := 0; - end Init_Context; - - procedure Push_Context (File : FILEs; Prev_Ctx : out Disp_Context) - is - begin - Prev_Ctx := Ctx; - Init_Context (File); - end Push_Context; - - -- Restore a previous context, saved by Push_Context. - procedure Pop_Context (Prev_Ctx : Disp_Context) is - begin - Flush; - Ctx := Prev_Ctx; - end Pop_Context; - - procedure Flush - is - Status : size_t; - Res : int; - pragma Unreferenced (Status, Res); - begin - if Ctx.Line_Len > 0 then - Status := fwrite (Ctx.Line'Address, size_t (Ctx.Line_Len), 1, - Ctx.File); - Res := fputc (Character'Pos (ASCII.Lf), Ctx.File); - Ctx.Line_Len := 0; - end if; - Ctx.Mark := 0; - end Flush; - - function Is_Top return Boolean is - begin - return Ctx.Tab = 0; - end Is_Top; - - procedure Put_Tab - is - Tab : Natural := Ctx.Next_Tab; - Max_Tab : constant Natural := 40; - begin - if Tab > Max_Tab then - -- Limit indentation length, to limit line length. - Tab := Max_Tab; - end if; - - Ctx.Line (1 .. Tab) := (others => ' '); - Ctx.Line_Len := Tab; - Ctx.Next_Tab := Ctx.Tab + 2; - end Put_Tab; - - procedure Put (Str : String) is - Saved : String (1 .. 80); - Len : Natural; - begin - if Ctx.Line_Len + Str'Length >= 80 then - if Ctx.Mark > 0 then - Len := Ctx.Line_Len - Ctx.Mark + 1; - Saved (1 .. Len) := Ctx.Line (Ctx.Mark .. Ctx.Line_Len); - Ctx.Line_Len := Ctx.Mark - 1; - Flush; - Put_Tab; - Ctx.Line (Ctx.Line_Len + 1 .. Ctx.Line_Len + Len) := - Saved (1 .. Len); - Ctx.Line_Len := Ctx.Line_Len + Len; - else - Flush; - end if; - end if; - if Ctx.Line_Len = 0 then - Put_Tab; - end if; - Ctx.Line (Ctx.Line_Len + 1 .. Ctx.Line_Len + Str'Length) := Str; - Ctx.Line_Len := Ctx.Line_Len + Str'Length; - end Put; - - procedure Put_Trim (Str : String) is - begin - for I in Str'Range loop - if Str (I) /= ' ' then - Put (Str (I .. Str'Last)); - return; - end if; - end loop; - end Put_Trim; - - procedure Put_Line (Str : String) is - begin - Put (Str); - Flush; - Ctx.Next_Tab := Ctx.Tab; - end Put_Line; - - procedure New_Line - is - Status : int; - pragma Unreferenced (Status); - begin - if Ctx.Line_Len > 0 then - Flush; - else - Status := fputc (Character'Pos (ASCII.LF), Ctx.File); - end if; - Ctx.Next_Tab := Ctx.Tab; - end New_Line; - - procedure Put (C : Character) - is - S : constant String (1 .. 1) := (1 => C); - begin - Put (S); - end Put; - - -- Add a tabulation. - -- Every new line will start at this tabulation. - procedure Add_Tab is - begin - Ctx.Tab := Ctx.Tab + 2; - Ctx.Next_Tab := Ctx.Tab; - end Add_Tab; - - -- Removed a tabulation. - -- The next new line will start at the previous tabulation. - procedure Rem_Tab is - begin - Ctx.Tab := Ctx.Tab - 2; - Ctx.Next_Tab := Ctx.Tab; - end Rem_Tab; - - procedure Set_Mark is - begin - Ctx.Mark := Ctx.Line_Len; - end Set_Mark; - - procedure Flush_File is - Status : int; - pragma Unreferenced (Status); - begin - Flush; - Status := fflush (Ctx.File); - end Flush_File; - end Formated_Output; - - use Formated_Output; - - procedure Init_Context (File : Interfaces.C_Streams.FILEs) is - begin - Formated_Output.Init_Context (File); - end Init_Context; - - procedure Disp_Enode (E : O_Enode; Etype : O_Tnode); - procedure Disp_Lnode (Node : O_Lnode); - procedure Disp_Snode (First, Last : O_Snode); - procedure Disp_Dnode (Decl : O_Dnode); - procedure Disp_Tnode (Atype : O_Tnode; Full : Boolean); - - procedure Disp_Ident (Id : O_Ident) is - begin - Put (Get_String (Id)); - end Disp_Ident; - - procedure Disp_Tnode_Name (Atype : O_Tnode) is - begin - Disp_Tnode (Atype, False); - end Disp_Tnode_Name; - - procedure Disp_Dnode_Name (Decl : O_Dnode) is - begin - Disp_Ident (Decl.Name); - end Disp_Dnode_Name; - - procedure Disp_Loop_Name (Stmt : O_Snode) is - begin - Put ("loop" & Natural'Image (Stmt.Loop_Level)); - end Disp_Loop_Name; - - function Get_Enode_Name (Kind : OE_Kind) return String - is - begin - case Kind is --- when OE_Boolean_Lit => --- return "boolean_lit"; --- when OE_Unsigned_Lit => --- return "unsigned_lit"; --- when OE_Signed_Lit => --- return "signed lit"; --- when OE_Float_Lit => --- return "float lit"; --- when OE_Null_Lit => --- return "null lit"; --- when OE_Enum_Lit => --- return "enum lit"; - --- when OE_Sizeof_Lit => --- return "sizeof lit"; --- when OE_Offsetof_Lit => --- return "offsetof lit"; --- when OE_Aggregate => --- return "aggregate"; --- when OE_Aggr_Element => --- return "aggr_element"; --- when OE_Union_Aggr => --- return "union aggr"; - - when OE_Lit => - return "lit"; - when OE_Add_Ov => - return "+#"; - when OE_Sub_Ov => - return "-#"; - when OE_Mul_Ov => - return "*#"; - when OE_Div_Ov => - return "/#"; - when OE_Rem_Ov => - return "rem#"; - when OE_Mod_Ov => - return "mod#"; - when OE_Exp_Ov => - return "**#"; - - when OE_And => - return "and"; - when OE_Or => - return "or"; - when OE_Xor => - return "xor"; - when OE_And_Then => - return "and_then"; - when OE_Or_Else => - return "or_else"; - - when OE_Not => - return "not"; - when OE_Neg_Ov => - return "-"; - when OE_Abs_Ov => - return "abs"; - - when OE_Eq => - return "="; - when OE_Neq => - return "/="; - when OE_Le => - return "<="; - when OE_Lt => - return "<"; - when OE_Ge => - return ">="; - when OE_Gt => - return ">"; - - when OE_Function_Call => - return "function call"; - when OE_Convert_Ov => - return "convert_ov"; - when OE_Address => - return "address"; - when OE_Unchecked_Address => - return "unchecked_address"; --- when OE_Subprogram_Address => --- return "subprg_address"; - when OE_Alloca => - return "alloca"; - when OE_Value => - return "value"; - when OE_Nil => - return "??"; - end case; - end Get_Enode_Name; - - function Get_Lnode_Name (Kind : OL_Kind) return String - is - begin - case Kind is - when OL_Obj => - return "obj"; - when OL_Indexed_Element => - return "indexed_element"; - when OL_Slice => - return "slice"; - when OL_Selected_Element => - return "selected_element"; - when OL_Access_Element => - return "access_element"; --- when OL_Param_Ref => --- return "param_ref"; --- when OL_Var_Ref => --- return "var_ref"; --- when OL_Const_Ref => --- return "const_ref"; - end case; - end Get_Lnode_Name; - - pragma Unreferenced (Get_Lnode_Name); - - procedure Disp_Enode_Name (Kind : OE_Kind) is - begin - Put (Get_Enode_Name (Kind)); - end Disp_Enode_Name; - - procedure Disp_Assoc_List (Head : O_Anode) - is - El : O_Anode; - begin - El := Head; - Put ("("); - if El /= null then - loop - Disp_Enode (El.Actual, El.Formal.Dtype); - El := El.Next; - exit when El = null; - Put (", "); - end loop; - end if; - Put (")"); - end Disp_Assoc_List; - - function Image (Lit : Integer) return String - is - S : constant String := Integer'Image (Lit); - begin - if S (1) = ' ' then - return S (2 .. S'Length); - else - return S; - end if; - end Image; - - -- Disp STR as a literal for scalar type LIT_TYPE. - procedure Disp_Lit (Lit_Type : O_Tnode; Known : Boolean; Str : String) is - begin - if Known and not Disp_All_Types then - Put_Trim (Str); - else - Disp_Tnode_Name (Lit_Type); - Put ("'["); - Put_Trim (Str); - Put (']'); - end if; - end Disp_Lit; - - -- Display C. If CTYPE is set, this is the known type of C. - procedure Disp_Cnode (C : O_Cnode; Ctype : O_Tnode) - is - Known : constant Boolean := Ctype /= O_Tnode_Null; - begin - -- Sanity check. - if Known then - if Ctype /= C.Ctype then - raise Program_Error; - end if; - end if; - - case C.Kind is - when OC_Unsigned_Lit => - if False and then (C.U_Val >= Character'Pos(' ') - and C.U_Val <= Character'Pos ('~')) - then - Put ('''); - Put (Character'Val (C.U_Val)); - Put ('''); - else - Disp_Lit (C.Ctype, Known, Unsigned_64'Image (C.U_Val)); - end if; - when OC_Signed_Lit => - Disp_Lit (C.Ctype, Known, Integer_64'Image (C.S_Val)); - when OC_Float_Lit => - Disp_Lit (C.Ctype, Known, IEEE_Float_64'Image (C.F_Val)); - when OC_Boolean_Lit => - -- Always disp the type of boolean literals. - Disp_Lit (C.Ctype, False, Get_String (C.B_Id)); - when OC_Null_Lit => - -- Always disp the type of null literals. - Disp_Lit (C.Ctype, False, "null"); - when OC_Enum_Lit => - -- Always disp the type of enum literals. - Disp_Lit (C.Ctype, False, Get_String (C.E_Name)); - when OC_Sizeof_Lit => - Disp_Tnode_Name (C.Ctype); - Put ("'sizeof ("); - Disp_Tnode_Name (C.S_Type); - Put (")"); - when OC_Alignof_Lit => - Disp_Tnode_Name (C.Ctype); - Put ("'alignof ("); - Disp_Tnode_Name (C.S_Type); - Put (")"); - when OC_Offsetof_Lit => - Disp_Tnode_Name (C.Ctype); - Put ("'offsetof ("); - Disp_Tnode_Name (C.Off_Field.Parent); - Put ("."); - Disp_Ident (C.Off_Field.Ident); - Put (")"); - when OC_Aggregate => - declare - El : O_Cnode; - El_Type : O_Tnode; - Field : O_Fnode; - begin - Put ('{'); - El := C.Aggr_Els; - case C.Ctype.Kind is - when ON_Record_Type => - Field := C.Ctype.Elements; - El_Type := Field.Ftype; - when ON_Array_Sub_Type => - Field := null; - El_Type := C.Ctype.Base_Type.El_Type; - when others => - raise Program_Error; - end case; - if El /= null then - loop - Set_Mark; - if Field /= null then - if Disp_All_Types then - Put ('.'); - Disp_Ident (Field.Ident); - Put (" = "); - end if; - El_Type := Field.Ftype; - Field := Field.Next; - end if; - Disp_Cnode (El.Aggr_Value, El_Type); - El := El.Aggr_Next; - exit when El = null; - Put (", "); - end loop; - end if; - Put ('}'); - end; - when OC_Aggr_Element => - Disp_Cnode (C.Aggr_Value, Ctype); - when OC_Union_Aggr => - Put ('{'); - Put ('.'); - Disp_Ident (C.Uaggr_Field.Ident); - Put (" = "); - Disp_Cnode (C.Uaggr_Value, C.Uaggr_Field.Ftype); - Put ('}'); - when OC_Address => - Disp_Tnode_Name (C.Ctype); - Put ("'address ("); - Disp_Dnode_Name (C.Decl); - Put (")"); - when OC_Unchecked_Address => - Disp_Tnode_Name (C.Ctype); - Put ("'unchecked_address ("); - Disp_Dnode_Name (C.Decl); - Put (")"); - when OC_Subprogram_Address => - Disp_Tnode_Name (C.Ctype); - Put ("'subprg_addr ("); - Disp_Dnode_Name (C.Decl); - Put (")"); - end case; - end Disp_Cnode; - - -- Disp E whose expected type is ETYPE (may not be set). - procedure Disp_Enode (E : O_Enode; Etype : O_Tnode) - is - begin - case E.Kind is - when OE_Lit => - Disp_Cnode (E.Lit, Etype); - when OE_Dyadic_Expr_Kind => - Put ("("); - Disp_Enode (E.Left, O_Tnode_Null); - Put (' '); - Disp_Enode_Name (E.Kind); - Put (' '); - Disp_Enode (E.Right, E.Left.Rtype); - Put (')'); - when OE_Compare_Expr_Kind => - Disp_Tnode_Name (E.Rtype); - Put ("'("); - Disp_Enode (E.Left, O_Tnode_Null); - Put (' '); - Disp_Enode_Name (E.Kind); - Put (' '); - Disp_Enode (E.Right, E.Left.Rtype); - Put (')'); - when OE_Monadic_Expr_Kind => - Disp_Enode_Name (E.Kind); - if E.Kind /= OE_Neg_Ov then - Put (' '); - end if; - Disp_Enode (E.Operand, Etype); - when OE_Address => - Disp_Tnode_Name (E.Rtype); - Put ("'address ("); - Disp_Lnode (E.Lvalue); - Put (")"); - when OE_Unchecked_Address => - Disp_Tnode_Name (E.Rtype); - Put ("'unchecked_address ("); - Disp_Lnode (E.Lvalue); - Put (")"); - when OE_Convert_Ov => - Disp_Tnode_Name (E.Rtype); - Put ("'conv ("); - Disp_Enode (E.Conv, O_Tnode_Null); - Put (')'); - when OE_Function_Call => - Disp_Dnode_Name (E.Func); - Put (' '); - Disp_Assoc_List (E.Assoc); - when OE_Alloca => - Disp_Tnode_Name (E.Rtype); - Put ("'alloca ("); - Disp_Enode (E.A_Size, O_Tnode_Null); - Put (')'); - when OE_Value => - Disp_Lnode (E.Value); - when OE_Nil => - null; - end case; - end Disp_Enode; - - procedure Disp_Lnode (Node : O_Lnode) is - begin - case Node.Kind is - when OL_Obj => - Disp_Dnode_Name (Node.Obj); - when OL_Access_Element => - Disp_Enode (Node.Acc_Base, O_Tnode_Null); - Put (".all"); - when OL_Indexed_Element => - Disp_Lnode (Node.Array_Base); - Put ('['); - Disp_Enode (Node.Index, O_Tnode_Null); - Put (']'); - when OL_Slice => - Disp_Lnode (Node.Slice_Base); - Put ('['); - Disp_Enode (Node.Slice_Index, O_Tnode_Null); - Put ("...]"); - when OL_Selected_Element => - Disp_Lnode (Node.Rec_Base); - Put ('.'); - Disp_Ident (Node.Rec_El.Ident); --- when OL_Var_Ref --- | OL_Const_Ref --- | OL_Param_Ref => --- Disp_Dnode_Name (Node.Decl); - end case; - end Disp_Lnode; - - procedure Disp_Fnodes (First : O_Fnode) - is - El : O_Fnode; - begin - Add_Tab; - El := First; - while El /= null loop - Disp_Ident (El.Ident); - Put (": "); - Disp_Tnode (El.Ftype, False); - Put_Line ("; "); - El := El.Next; - end loop; - Rem_Tab; - end Disp_Fnodes; - - procedure Disp_Tnode (Atype : O_Tnode; Full : Boolean) is - begin - if not Full and Atype.Decl /= null then - Disp_Ident (Atype.Decl.Name); - return; - end if; - case Atype.Kind is - when ON_Boolean_Type => - Put ("boolean {"); - Disp_Ident (Atype.False_N.B_Id); - Put (", "); - Disp_Ident (Atype.True_N.B_Id); - Put ("}"); - when ON_Unsigned_Type => - Put ("unsigned ("); - Put_Trim (Natural'Image (Atype.Int_Size)); - Put (")"); - when ON_Signed_Type => - Put ("signed ("); - Put_Trim (Natural'Image (Atype.Int_Size)); - Put (")"); - when ON_Float_Type => - Put ("float"); - when ON_Enum_Type => - declare - El : O_Cnode; - begin - Put ("enum {"); - El := Atype.Literals; - while El /= O_Cnode_Null loop - Set_Mark; - Disp_Ident (El.E_Name); - Put (" = "); - Put (Image (El.E_Val)); - El := El.E_Next; - exit when El = O_Cnode_Null; - Put (", "); - end loop; - Put ("}"); - end; - when ON_Array_Type => - Put ("array ["); - Disp_Tnode (Atype.Index_Type, False); - Put ("] of "); - Disp_Tnode (Atype.El_Type, False); - when ON_Access_Type => - Put ("access "); - if Atype.D_Type /= O_Tnode_Null then - Disp_Tnode (Atype.D_Type, False); - end if; - when ON_Record_Type => - Put_Line ("record "); - Disp_Fnodes (Atype.Elements); - Put ("end record"); - when ON_Union_Type => - Put_Line ("union "); - Disp_Fnodes (Atype.Elements); - Put ("end union"); - when ON_Array_Sub_Type => - Put ("subarray "); - Disp_Tnode_Name (Atype.Base_Type); - Put ("["); - Disp_Cnode (Atype.Length, Atype.Base_Type.Index_Type); - Put ("]"); - end case; - end Disp_Tnode; - - procedure Disp_Storage_Name (Storage : O_Storage) is - begin - case Storage is - when O_Storage_External => - Put ("external"); - when O_Storage_Public => - Put ("public"); - when O_Storage_Private => - Put ("private"); - when O_Storage_Local => - Put ("local"); - end case; - end Disp_Storage_Name; - - procedure Disp_Decls (Decls : O_Dnode) - is - El : O_Dnode; - begin - El := Decls; - while El /= null loop - Disp_Dnode (El); - El := El.Next; - if Is_Top then - -- NOTE: some declaration does not disp anything, so there may be - -- double new line. - New_Line; - end if; - end loop; - end Disp_Decls; - - procedure Disp_Function_Decl (Decl : O_Dnode) is - begin - Disp_Storage_Name (Decl.Storage); - Put (" "); - if Decl.Dtype = null then - Put ("procedure "); - else - Put ("function "); - end if; - Disp_Ident (Decl.Name); - Put_Line (" ("); - Add_Tab; - declare - El : O_Dnode; - begin - El := Decl.Interfaces; - if El /= null then - loop - Disp_Dnode (El); - El := El.Next; - exit when El = null; - Put_Line (";"); - end loop; - end if; - Put (")"); - end; - if Decl.Dtype /= null then - New_Line; - Put ("return "); - Disp_Tnode (Decl.Dtype, False); - end if; - Rem_Tab; - end Disp_Function_Decl; - - procedure Disp_Dnode (Decl : O_Dnode) is - begin - case Decl.Kind is - when ON_Type_Decl => - Put ("type "); - Disp_Ident (Decl.Name); - Put (" is "); - if not Decl.Dtype.Uncomplete then - Disp_Tnode (Decl.Dtype, True); - else - case Decl.Dtype.Kind is - when ON_Record_Type => - Put ("record"); - when ON_Access_Type => - Put ("access"); - when others => - raise Program_Error; - end case; - end if; - Put_Line (";"); - when ON_Completed_Type_Decl => - Put ("type "); - Disp_Ident (Decl.Name); - Put (" is "); - Disp_Tnode (Decl.Dtype, True); - Put_Line (";"); - when ON_Const_Decl => - Disp_Storage_Name (Decl.Storage); - Put (" "); - Put ("constant "); - Disp_Ident (Decl.Name); - Put (" : "); - Disp_Tnode_Name (Decl.Dtype); - Put_Line (";"); - when ON_Const_Value => - Put ("constant "); - Disp_Ident (Decl.Name); - Put (" := "); - Disp_Cnode (Decl.Value, Decl.Dtype); - Put_Line (";"); - when ON_Var_Decl => - Disp_Storage_Name (Decl.Storage); - Put (" "); - Put ("var "); - Disp_Ident (Decl.Name); - Put (" : "); - Disp_Tnode_Name (Decl.Dtype); - Put_Line (";"); - when ON_Function_Decl => - if Decl.Next = null or Decl.Next /= Decl.Func_Body then - -- This is a forward/external declaration. - Disp_Function_Decl (Decl); - Put_Line (";"); - end if; - when ON_Function_Body => - Disp_Function_Decl (Decl.Func_Decl); - New_Line; - Disp_Snode (Decl.Func_Stmt, Decl.Func_Stmt); - when ON_Interface_Decl => - Disp_Ident (Decl.Name); - Put (": "); - Disp_Tnode (Decl.Dtype, False); - when ON_Debug_Line_Decl => - Put_Line ("--#" & Natural'Image (Decl.Line)); - when ON_Debug_Comment_Decl => - Put_Line ("-- " & Decl.Comment.all); - when ON_Debug_Filename_Decl => - Put_Line ("--F " & Decl.Filename.all); - end case; - end Disp_Dnode; - - procedure Disp_Snode (First : O_Snode; Last : O_Snode) is - Stmt : O_Snode; - begin - Stmt := First; - loop - --if Stmt.Kind = ON_Elsif_Stmt or Stmt.Kind = ON_When_Stmt then - -- Put_Indent (Tab - 1); - --else - -- Put_Indent (Tab); - --end if; - case Stmt.Kind is - when ON_Declare_Stmt => - Put_Line ("declare"); - Add_Tab; - Disp_Decls (Stmt.Decls); - Rem_Tab; - Put_Line ("begin"); - Add_Tab; - if Stmt.Stmts /= null then - Disp_Snode (Stmt.Stmts, null); - end if; - Rem_Tab; - Put_Line ("end;"); - when ON_Assign_Stmt => - Disp_Lnode (Stmt.Target); - Put (" := "); - Disp_Enode (Stmt.Value, Stmt.Target.Rtype); - Put_Line (";"); - when ON_Return_Stmt => - Put ("return "); - if Stmt.Ret_Val /= null then - Disp_Enode (Stmt.Ret_Val, O_Tnode_Null); - end if; - Put_Line (";"); - when ON_If_Stmt => - Add_Tab; - Disp_Snode (Stmt.Next, Stmt.If_Last); - Stmt := Stmt.If_Last; - Rem_Tab; - Put_Line ("end if;"); - when ON_Elsif_Stmt => - Rem_Tab; - if Stmt.Cond = null then - Put_Line ("else"); - else - if First = Stmt then - Put ("if "); - else - Put ("elsif "); - end if; - Disp_Enode (Stmt.Cond, O_Tnode_Null); - Put_Line (" then"); - end if; - Add_Tab; - when ON_Loop_Stmt => - Disp_Loop_Name (Stmt); - Put_Line (":"); - Add_Tab; - Disp_Snode (Stmt.Next, Stmt.Loop_Last); - Stmt := Stmt.Loop_Last; - Rem_Tab; - Put_Line ("end loop;"); - when ON_Exit_Stmt => - Put ("exit "); - Disp_Loop_Name (Stmt.Loop_Id); - Put_Line (";"); - when ON_Next_Stmt => - Put ("next "); - Disp_Loop_Name (Stmt.Loop_Id); - Put_Line (";"); - when ON_Case_Stmt => - Put ("case "); - Disp_Enode (Stmt.Selector, O_Tnode_Null); - Put_Line (" is"); - Add_Tab; - Disp_Snode (Stmt.Next, Stmt.Case_Last); - Stmt := Stmt.Case_Last; - Rem_Tab; - Put_Line ("end case;"); - when ON_When_Stmt => - declare - Choice: O_Choice; - Choice_Type : constant O_Tnode := - Stmt.Branch_Parent.Selector.Rtype; - begin - Rem_Tab; - Choice := Stmt.Choice_List; - Put ("when "); - loop - case Choice.Kind is - when ON_Choice_Expr => - Disp_Cnode (Choice.Expr, Choice_Type); - when ON_Choice_Range => - Disp_Cnode (Choice.Low, Choice_Type); - Put (" ... "); - Disp_Cnode (Choice.High, Choice_Type); - when ON_Choice_Default => - Put ("default"); - end case; - Choice := Choice.Next; - exit when Choice = null; - Put_Line (","); - Put (" "); - end loop; - Put_Line (" =>"); - Add_Tab; - end; - when ON_Call_Stmt => - Disp_Dnode_Name (Stmt.Proc); - Put (' '); - Disp_Assoc_List (Stmt.Assoc); - Put_Line (";"); - when ON_Debug_Line_Stmt => - Put_Line ("--#" & Natural'Image (Stmt.Line)); - when ON_Debug_Comment_Stmt => - Put_Line ("-- " & Stmt.Comment.all); - end case; - exit when Stmt = Last; - Stmt := Stmt.Next; - exit when Stmt = null and Last = null; - end loop; - end Disp_Snode; - - procedure Disp_Ortho (Decls : O_Snode) is - begin - Disp_Decls (Decls.Decls); - Flush; - end Disp_Ortho; - - procedure Disp_Tnode_Decl (N : O_Tnode) is - begin - Disp_Ident (N.Decl.Name); - Put (" : "); - Disp_Tnode (N, True); - end Disp_Tnode_Decl; - - procedure Debug_Tnode (N : O_Tnode) - is - Ctx : Disp_Context; - begin - Push_Context (Interfaces.C_Streams.stdout, Ctx); - Disp_Tnode_Decl (N); - Pop_Context (Ctx); - end Debug_Tnode; - - procedure Debug_Enode (N : O_Enode) - is - Ctx : Disp_Context; - begin - Push_Context (Interfaces.C_Streams.stdout, Ctx); - Disp_Enode (N, O_Tnode_Null); - Put (" : "); - Disp_Tnode_Decl (N.Rtype); - Pop_Context (Ctx); - end Debug_Enode; - - procedure Debug_Fnode (N : O_Fnode) - is - Ctx : Disp_Context; - begin - Push_Context (Interfaces.C_Streams.stdout, Ctx); - Disp_Ident (N.Ident); - Put (": "); - Disp_Tnode (N.Ftype, False); - Pop_Context (Ctx); - end Debug_Fnode; - - procedure Debug_Dnode (N : O_Dnode) - is - Ctx : Disp_Context; - begin - Push_Context (Interfaces.C_Streams.stdout, Ctx); - Disp_Dnode (N); - Pop_Context (Ctx); - end Debug_Dnode; - - procedure Debug_Lnode (N : O_Lnode) - is - Ctx : Disp_Context; - begin - Push_Context (Interfaces.C_Streams.stdout, Ctx); - Disp_Lnode (N); - Put (" : "); - Disp_Tnode_Decl (N.Rtype); - Pop_Context (Ctx); - end Debug_Lnode; - - procedure Debug_Snode (N : O_Snode) - is - Ctx : Disp_Context; - begin - Push_Context (Interfaces.C_Streams.stdout, Ctx); - Disp_Snode (N, null); - Pop_Context (Ctx); - end Debug_Snode; - - pragma Unreferenced (Debug_Tnode, Debug_Enode, Debug_Fnode, - Debug_Dnode, Debug_Lnode, Debug_Snode); -end Ortho_Debug.Disp; diff --git a/ortho/debug/ortho_debug-disp.ads b/ortho/debug/ortho_debug-disp.ads deleted file mode 100644 index c365a3530..000000000 --- a/ortho/debug/ortho_debug-disp.ads +++ /dev/null @@ -1,29 +0,0 @@ --- Display the ortho codes from a tree. --- Copyright (C) 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GCC; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Interfaces.C_Streams; - -package Ortho_Debug.Disp is - -- Initialize the current context. - -- Must be called before any use of the DISP_* subprograms. - procedure Init_Context (File : Interfaces.C_Streams.FILEs); - - -- Disp nodes in a pseudo-language. - procedure Disp_Ortho (Decls : O_Snode); - -private -end Ortho_Debug.Disp; diff --git a/ortho/debug/ortho_debug-main.adb b/ortho/debug/ortho_debug-main.adb deleted file mode 100644 index b470deaab..000000000 --- a/ortho/debug/ortho_debug-main.adb +++ /dev/null @@ -1,151 +0,0 @@ --- Main procedure of ortho debug back-end. --- Copyright (C) 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GCC; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Ada.Command_Line; use Ada.Command_Line; -with Ada.Unchecked_Deallocation; -with Ada.Text_IO; use Ada.Text_IO; -with Ortho_Debug; use Ortho_Debug; -with Ortho_Debug_Front; use Ortho_Debug_Front; -with Ortho_Debug.Disp; -with System; use System; -with Interfaces.C_Streams; use Interfaces.C_Streams; - -procedure Ortho_Debug.Main is - -- Do not output the ortho code. - Flag_Silent : Boolean := False; - - -- Force output, even in case of crash. - Flag_Force : Boolean := False; - - I : Natural; - Argc : Natural; - Arg : String_Acc; - Opt : String_Acc; - Res : Natural; - File : String_Acc; - Output : FILEs; - R : Boolean; - - procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation - (Name => String_Acc, Object => String); -begin - Ortho_Debug_Front.Init; - Output := NULL_Stream; - - Set_Exit_Status (Failure); - - -- Decode options. - Argc := Argument_Count; - I := 1; - loop - exit when I > Argc; - exit when Argument (I) (1) /= '-'; - if Argument (I) = "--silent" or else Argument (I) = "-quiet" then - Flag_Silent := True; - I := I + 1; - elsif Argument (I) = "--force" then - Flag_Force := True; - I := I + 1; - elsif Argument (I)'Length >= 2 and then Argument (I)(2) = 'g' then - -- Skip -g[XXX] flags. - I := I + 1; - elsif Argument (I) = "-o" and then I + 1 <= Argc then - -- TODO: write the output to the file ? - if Output /= NULL_Stream then - Put_Line (Command_Name & ": only one output allowed"); - return; - end if; - declare - Name : String := Argument (I + 1) & ASCII.Nul; - Mode : String := 'w' & ASCII.Nul; - begin - Output := fopen (Name'Address, Mode'Address); - if Output = NULL_Stream then - Put_Line (Command_Name & ": cannot open " & Argument (I + 1)); - return; - end if; - end; - I := I + 2; - else - Opt := new String'(Argument (I)); - if I < Argc then - Arg := new String'(Argument (I + 1)); - else - Arg := null; - end if; - Res := Ortho_Debug_Front.Decode_Option (Opt, Arg); - Unchecked_Deallocation (Opt); - Unchecked_Deallocation (Arg); - if Res = 0 then - Put_Line (Argument (I) & ": unknown option"); - return; - else - I := I + Res; - end if; - end if; - end loop; - - -- Initialize tree. - begin - Ortho_Debug.Init; - - if I <= Argc then - R := True; - for J in I .. Argc loop - File := new String'(Argument (J)); - R := R and Ortho_Debug_Front.Parse (File); - Unchecked_Deallocation (File); - end loop; - else - R := Ortho_Debug_Front.Parse (null); - end if; - Ortho_Debug.Finish; - exception - when others => - if not Flag_Force then - raise; - else - R := False; - end if; - end; - - -- Write down the result. - if (R and (Output /= NULL_Stream or not Flag_Silent)) - or Flag_Force - then - if Output = NULL_Stream then - Ortho_Debug.Disp.Init_Context (stdout); - else - Ortho_Debug.Disp.Init_Context (Output); - end if; - Ortho_Debug.Disp.Disp_Ortho (Ortho_Debug.Top); - if Output /= NULL_Stream then - declare - Status : int; - pragma Unreferenced (Status); - begin - Status := fclose (Output); - end; - end if; - end if; - - if R then - Set_Exit_Status (Success); - else - Set_Exit_Status (Failure); - end if; -end Ortho_Debug.Main; diff --git a/ortho/debug/ortho_debug.adb b/ortho/debug/ortho_debug.adb deleted file mode 100644 index 8285a6473..000000000 --- a/ortho/debug/ortho_debug.adb +++ /dev/null @@ -1,1931 +0,0 @@ --- Ortho debug back-end. --- Copyright (C) 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GCC; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Ada.Unchecked_Deallocation; - -package body Ortho_Debug is - -- If True, disable some checks so that the output can be generated. - Disable_Checks : constant Boolean := False; - - type ON_Op_To_OE_Type is array (ON_Op_Kind) of OE_Kind; - ON_Op_To_OE : constant ON_Op_To_OE_Type := - ( - ON_Nil => OE_Nil, - - -- Dyadic operations. - ON_Add_Ov => OE_Add_Ov, - ON_Sub_Ov => OE_Sub_Ov, - ON_Mul_Ov => OE_Mul_Ov, - ON_Div_Ov => OE_Div_Ov, - ON_Rem_Ov => OE_Rem_Ov, - ON_Mod_Ov => OE_Mod_Ov, - - -- Binary operations. - ON_And => OE_And, - ON_Or => OE_Or, - ON_Xor => OE_Xor, - - -- Monadic operations. - ON_Not => OE_Not, - ON_Neg_Ov => OE_Neg_Ov, - ON_Abs_Ov => OE_Abs_Ov, - - -- Comparaisons - ON_Eq => OE_Eq, - ON_Neq => OE_Neq, - ON_Le => OE_Le, - ON_Lt => OE_Lt, - ON_Ge => OE_Ge, - ON_Gt => OE_Gt - ); - - type Decl_Scope_Type is record - -- Declarations are chained. - Parent : O_Snode; - Last_Decl : O_Dnode; - Last_Stmt : O_Snode; - - -- If this scope corresponds to a function, PREV_FUNCTION contains - -- the previous function. - Prev_Function : O_Dnode; - - -- Declaration scopes are chained. - Prev : Decl_Scope_Acc; - end record; - - type Stmt_Kind is - (Stmt_Function, Stmt_Declare, Stmt_If, Stmt_Loop, Stmt_Case); - type Stmt_Scope_Type (Kind : Stmt_Kind); - type Stmt_Scope_Acc is access Stmt_Scope_Type; - type Stmt_Scope_Type (Kind : Stmt_Kind) is record - -- Statement which created this scope. - Parent : O_Snode; - -- Previous (parent) scope. - Prev : Stmt_Scope_Acc; - case Kind is - when Stmt_Function => - Prev_Function : Stmt_Scope_Acc; - -- Declaration for the function. - Decl : O_Dnode; - when Stmt_Declare => - null; - when Stmt_If => - Last_Elsif : O_Snode; - when Stmt_Loop => - null; - when Stmt_Case => - Last_Branch : O_Snode; - Last_Choice : O_Choice; - Case_Type : O_Tnode; - end case; - end record; - subtype Stmt_Function_Scope_Type is Stmt_Scope_Type (Stmt_Function); - subtype Stmt_Declare_Scope_Type is Stmt_Scope_Type (Stmt_Declare); - subtype Stmt_If_Scope_Type is Stmt_Scope_Type (Stmt_If); - subtype Stmt_Loop_Scope_Type is Stmt_Scope_Type (Stmt_Loop); - subtype Stmt_Case_Scope_Type is Stmt_Scope_Type (Stmt_Case); - - Current_Stmt_Scope : Stmt_Scope_Acc := null; - Current_Function : Stmt_Scope_Acc := null; - Current_Decl_Scope : Decl_Scope_Acc := null; - Current_Loop_Level : Natural := 0; - - procedure Push_Decl_Scope (Parent : O_Snode) - is - Res : Decl_Scope_Acc; - begin - Res := new Decl_Scope_Type'(Parent => Parent, - Last_Decl => null, - Last_Stmt => null, - Prev_Function => null, - Prev => Current_Decl_Scope); - Parent.Alive := True; - Current_Decl_Scope := Res; - end Push_Decl_Scope; - - procedure Pop_Decl_Scope - is - procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation - (Object => Decl_Scope_Type, Name => Decl_Scope_Acc); - Old : Decl_Scope_Acc; - begin - Old := Current_Decl_Scope; - Old.Parent.Alive := False; - Current_Decl_Scope := Old.Prev; - Unchecked_Deallocation (Old); - end Pop_Decl_Scope; - - procedure Add_Decl (El : O_Dnode; Check_Dup : Boolean := True) is - begin - if Current_Decl_Scope = null then - -- Not yet initialized, or after compilation. - raise Program_Error; - end if; - - -- Note: this requires an hashed ident table. - -- Use ortho_ident_hash. - if False and then Check_Dup - and then not Is_Nul (El.Name) - then - -- Check the name is not already defined. - declare - E : O_Dnode; - begin - E := Current_Decl_Scope.Parent.Decls; - while E /= O_Dnode_Null loop - if Is_Equal (E.Name, El.Name) then - raise Syntax_Error; - end if; - E := E.Next; - end loop; - end; - end if; - - if Current_Decl_Scope.Last_Decl = null then - if Current_Decl_Scope.Parent.Kind = ON_Declare_Stmt then - Current_Decl_Scope.Parent.Decls := El; - else - raise Type_Error; - end if; - else - Current_Decl_Scope.Last_Decl.Next := El; - end if; - El.Next := null; - Current_Decl_Scope.Last_Decl := El; - end Add_Decl; - - procedure Add_Stmt (Stmt : O_Snode) - is - begin - if Current_Decl_Scope = null or Current_Function = null then - -- You are adding a statement at the global level, ie not inside - -- a function. - raise Syntax_Error; - end if; - - Stmt.Next := null; - if Current_Decl_Scope.Last_Stmt = null then - if Current_Decl_Scope.Parent.Kind = ON_Declare_Stmt then - Current_Decl_Scope.Parent.Stmts := Stmt; - else - raise Syntax_Error; - end if; - else - Current_Decl_Scope.Last_Stmt.Next := Stmt; - end if; - Current_Decl_Scope.Last_Stmt := Stmt; - end Add_Stmt; - - procedure Push_Stmt_Scope (Scope : Stmt_Scope_Acc) - is - begin - if Scope.Prev /= Current_Stmt_Scope then - -- SCOPE was badly initialized. - raise Program_Error; - end if; - Current_Stmt_Scope := Scope; - end Push_Stmt_Scope; - - procedure Pop_Stmt_Scope (Kind : Stmt_Kind) - is - procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation - (Object => Stmt_Scope_Type, Name => Stmt_Scope_Acc); - Old : Stmt_Scope_Acc; - begin - Old := Current_Stmt_Scope; - if Old.Kind /= Kind then - raise Syntax_Error; - end if; - --Old.Parent.Last_Stmt := Current_Decl_Scope.Last_Stmt; - Current_Stmt_Scope := Old.Prev; - Unchecked_Deallocation (Old); - end Pop_Stmt_Scope; - - -- Check declaration DECL is reachable, ie its scope is in the current - -- stack of scopes. - procedure Check_Scope (Decl : O_Dnode) - is - Res : Boolean; - begin - case Decl.Kind is - when ON_Interface_Decl => - Res := Decl.Func_Scope.Alive; - when others => - Res := Decl.Scope.Alive; - end case; - if not Res then - raise Syntax_Error; - end if; - end Check_Scope; - - -- Raise SYNTAX_ERROR if OBJ is not at a constant address. --- procedure Check_Const_Address (Obj : O_Lnode) is --- begin --- case Obj.Kind is --- when OL_Const_Ref --- | OL_Var_Ref => --- case Obj.Decl.Storage is --- when O_Storage_External --- | O_Storage_Public --- | O_Storage_Private => --- null; --- when O_Storage_Local => --- raise Syntax_Error; --- end case; --- when others => --- -- FIXME: constant indexed element, selected element maybe --- -- of const address. --- raise Syntax_Error; --- end case; --- end Check_Const_Address; - - procedure Check_Type (T1, T2 : O_Tnode) is - begin - if T1 = T2 then - return; - end if; - if T1.Kind = ON_Array_Sub_Type and then T2.Kind = ON_Array_Sub_Type - and then T1.Base_Type = T2.Base_Type - and then T1.Length.all = T2.Length.all - then - return; - end if; - raise Type_Error; - end Check_Type; - - procedure Check_Ref (N : O_Enode) is - begin - if N.Ref then - -- Already referenced. - raise Syntax_Error; - end if; - N.Ref := True; - end Check_Ref; - - procedure Check_Ref (N : O_Lnode) is - begin - if N.Ref then - raise Syntax_Error; - end if; - N.Ref := True; - end Check_Ref; - - procedure Check_Complete_Type (T : O_Tnode) is - begin - if not T.Complete then - -- Uncomplete type cannot be used here (since its size is required, - -- for example). - raise Syntax_Error; - end if; - end Check_Complete_Type; - - function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode) - return O_Enode - is - K : constant OE_Kind := ON_Op_To_OE (Kind); - Res : O_Enode; - begin - Check_Type (Left.Rtype, Right.Rtype); - Check_Ref (Left); - Check_Ref (Right); - Res := new O_Enode_Type (K); - Res.Rtype := Left.Rtype; - Res.Ref := False; - Res.Left := Left; - Res.Right := Right; - return Res; - end New_Dyadic_Op; - - function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode) - return O_Enode - is - Res : O_Enode; - begin - Check_Ref (Operand); - Res := new O_Enode_Type (ON_Op_To_OE (Kind)); - Res.Ref := False; - Res.Operand := Operand; - Res.Rtype := Operand.Rtype; - return Res; - end New_Monadic_Op; - - function New_Compare_Op - (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode) - return O_Enode - is - Res : O_Enode; - begin - if Ntype.Kind /= ON_Boolean_Type then - raise Type_Error; - end if; - if Left.Rtype /= Right.Rtype then - raise Type_Error; - end if; - Check_Ref (Left); - Check_Ref (Right); - Res := new O_Enode_Type (ON_Op_To_OE (Kind)); - Res.Ref := False; - Res.Left := Left; - Res.Right := Right; - Res.Rtype := Ntype; - return Res; - end New_Compare_Op; - - - function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64) - return O_Cnode - is - subtype O_Cnode_Signed_Lit is O_Cnode_Type (OC_Signed_Lit); - begin - if Ltype.Kind = ON_Signed_Type then - return new O_Cnode_Signed_Lit'(Kind => OC_Signed_Lit, - Ctype => Ltype, - Ref => False, - S_Val => Value); - else - raise Type_Error; - end if; - end New_Signed_Literal; - - function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64) - return O_Cnode - is - subtype O_Cnode_Unsigned_Lit is O_Cnode_Type (OC_Unsigned_Lit); - begin - if Ltype.Kind = ON_Unsigned_Type then - return new O_Cnode_Unsigned_Lit'(Kind => OC_Unsigned_Lit, - Ctype => Ltype, - Ref => False, - U_Val => Value); - else - raise Type_Error; - end if; - end New_Unsigned_Literal; - - function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64) - return O_Cnode - is - subtype O_Cnode_Float_Lit is O_Cnode_Type (OC_Float_Lit); - begin - if Ltype.Kind = ON_Float_Type then - return new O_Cnode_Float_Lit'(Kind => OC_Float_Lit, - Ctype => Ltype, - Ref => False, - F_Val => Value); - else - raise Type_Error; - end if; - end New_Float_Literal; - - function New_Null_Access (Ltype : O_Tnode) return O_Cnode - is - subtype O_Cnode_Null_Lit_Type is O_Cnode_Type (OC_Null_Lit); - begin - if Ltype.Kind /= ON_Access_Type then - raise Type_Error; - end if; - return new O_Cnode_Null_Lit_Type'(Kind => OC_Null_Lit, - Ctype => Ltype, - Ref => False); - end New_Null_Access; - - function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode - is - subtype O_Cnode_Sizeof_Type is O_Cnode_Type (OC_Sizeof_Lit); - begin - if Rtype.Kind /= ON_Unsigned_Type - and then Rtype.Kind /= ON_Access_Type - then - raise Type_Error; - end if; - Check_Complete_Type (Atype); - if Atype.Kind = ON_Array_Type then - raise Type_Error; - end if; - return new O_Cnode_Sizeof_Type'(Kind => OC_Sizeof_Lit, - Ctype => Rtype, - Ref => False, - S_Type => Atype); - end New_Sizeof; - - function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode - is - subtype O_Cnode_Alignof_Type is O_Cnode_Type (OC_Alignof_Lit); - begin - if Rtype.Kind /= ON_Unsigned_Type then - raise Type_Error; - end if; - Check_Complete_Type (Atype); - return new O_Cnode_Alignof_Type'(Kind => OC_Alignof_Lit, - Ctype => Rtype, - Ref => False, - S_Type => Atype); - end New_Alignof; - - function New_Offsetof (Atype : O_Tnode; Field : O_Fnode; Rtype : O_Tnode) - return O_Cnode - is - subtype O_Cnode_Offsetof_Type is O_Cnode_Type (OC_Offsetof_Lit); - begin - if Rtype.Kind /= ON_Unsigned_Type - and then Rtype.Kind /= ON_Access_Type - then - raise Type_Error; - end if; - if Field.Parent /= Atype then - raise Type_Error; - end if; - return new O_Cnode_Offsetof_Type'(Kind => OC_Offsetof_Lit, - Ctype => Rtype, - Ref => False, - Off_Field => Field); - end New_Offsetof; - - function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode - is - subtype O_Enode_Alloca_Type is O_Enode_Type (OE_Alloca); - Res : O_Enode; - begin - if Rtype.Kind /= ON_Access_Type then - raise Type_Error; - end if; - if Size.Rtype.Kind /= ON_Unsigned_Type then - raise Type_Error; - end if; - Res := new O_Enode_Alloca_Type'(Kind => OE_Alloca, - Rtype => Rtype, - Ref => False, - A_Size => Size); - return Res; - end New_Alloca; - - procedure Check_Constrained_Type (Atype : O_Tnode) is - begin - case Atype.Kind is - when ON_Array_Type => - raise Type_Error; - when ON_Unsigned_Type - | ON_Signed_Type - | ON_Boolean_Type - | ON_Record_Type - | ON_Union_Type - | ON_Access_Type - | ON_Float_Type - | ON_Array_Sub_Type - | ON_Enum_Type => - null; - end case; - end Check_Constrained_Type; - - procedure New_Completed_Type_Decl (Atype : O_Tnode) - is - N : O_Dnode; - begin - if Atype.Decl = null then - -- The uncompleted type must have been declared. - raise Type_Error; - end if; - N := new O_Dnode_Type (ON_Completed_Type_Decl); - N.Name := Atype.Decl.Name; - N.Dtype := Atype; - Add_Decl (N, False); - end New_Completed_Type_Decl; - - procedure New_Uncomplete_Record_Type (Res : out O_Tnode) - is - subtype O_Tnode_Record_Type is O_Tnode_Type (ON_Record_Type); - begin - Res := new O_Tnode_Record_Type'(Kind => ON_Record_Type, - Decl => O_Dnode_Null, - Uncomplete => True, - Complete => False, - Elements => O_Fnode_Null); - end New_Uncomplete_Record_Type; - - procedure Start_Uncomplete_Record_Type (Res : O_Tnode; - Elements : out O_Element_List) is - begin - if not Res.Uncomplete then - -- RES record type is not an uncomplete record type. - raise Syntax_Error; - end if; - if Res.Elements /= O_Fnode_Null then - -- RES record type already has elements... - raise Syntax_Error; - end if; - Elements.Res := Res; - Elements.Last := null; - end Start_Uncomplete_Record_Type; - - procedure Start_Record_Type (Elements : out O_Element_List) - is - subtype O_Tnode_Record_Type is O_Tnode_Type (ON_Record_Type); - begin - Elements.Res := new O_Tnode_Record_Type'(Kind => ON_Record_Type, - Decl => O_Dnode_Null, - Uncomplete => False, - Complete => False, - Elements => O_Fnode_Null); - Elements.Last := null; - end Start_Record_Type; - - procedure New_Record_Field - (Elements : in out O_Element_List; - El : out O_Fnode; - Ident : O_Ident; Etype : O_Tnode) - is - begin - Check_Complete_Type (Etype); - Check_Constrained_Type (Etype); - El := new O_Fnode_Type'(Parent => Elements.Res, - Next => null, - Ident => Ident, - Ftype => Etype, - Offset => 0); - -- Append EL. - if Elements.Last = null then - Elements.Res.Elements := El; - else - Elements.Last.Next := El; - end if; - Elements.Last := El; - end New_Record_Field; - - procedure Finish_Record_Type - (Elements : in out O_Element_List; Res : out O_Tnode) is - begin - -- Align the structure. - Res := Elements.Res; - if Res.Uncomplete then - New_Completed_Type_Decl (Res); - end if; - Res.Complete := True; - end Finish_Record_Type; - - procedure Start_Union_Type (Elements : out O_Element_List) - is - subtype O_Tnode_Union_Type is O_Tnode_Type (ON_Union_Type); - begin - Elements.Res := new O_Tnode_Union_Type'(Kind => ON_Union_Type, - Decl => O_Dnode_Null, - Uncomplete => False, - Complete => False, - Elements => O_Fnode_Null); - Elements.Last := null; - end Start_Union_Type; - - procedure New_Union_Field - (Elements : in out O_Element_List; - El : out O_Fnode; - Ident : O_Ident; Etype : O_Tnode) - is - begin - New_Record_Field (Elements, El, Ident, Etype); - end New_Union_Field; - - procedure Finish_Union_Type - (Elements : in out O_Element_List; Res : out O_Tnode) is - begin - Res := Elements.Res; - Res.Complete := True; - end Finish_Union_Type; - - function New_Access_Type (Dtype : O_Tnode) return O_Tnode - is - subtype O_Tnode_Access is O_Tnode_Type (ON_Access_Type); - Res : O_Tnode; - begin - if Dtype /= O_Tnode_Null - and then Dtype.Kind = ON_Array_Sub_Type - then - -- Access to sub array are not allowed, use access to array. - raise Type_Error; - end if; - Res := new O_Tnode_Access'(Kind => ON_Access_Type, - Decl => O_Dnode_Null, - Uncomplete => Dtype = O_Tnode_Null, - Complete => True, - D_Type => Dtype); - return Res; - end New_Access_Type; - - procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode) - is - begin - if Dtype.Kind = ON_Array_Sub_Type then - -- Access to sub array are not allowed, use access to array. - raise Type_Error; - end if; - if Atype.D_Type /= O_Tnode_Null - or Atype.Uncomplete = False - then - -- Type already completed. - raise Syntax_Error; - end if; - Atype.D_Type := Dtype; - New_Completed_Type_Decl (Atype); - end Finish_Access_Type; - - function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode) - return O_Tnode - is - subtype O_Tnode_Array is O_Tnode_Type (ON_Array_Type); - begin - Check_Constrained_Type (El_Type); - Check_Complete_Type (El_Type); - return new O_Tnode_Array'(Kind => ON_Array_Type, - Decl => O_Dnode_Null, - Uncomplete => False, - Complete => True, - El_Type => El_Type, - Index_Type => Index_Type); - end New_Array_Type; - - function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode) - return O_Tnode - is - subtype O_Tnode_Sub_Array is O_Tnode_Type (ON_Array_Sub_Type); - begin - if Atype.Kind /= ON_Array_Type then - raise Type_Error; - end if; - return new O_Tnode_Sub_Array'(Kind => ON_Array_Sub_Type, - Decl => O_Dnode_Null, - Uncomplete => False, - Complete => True, - Base_Type => Atype, - Length => Length); - end New_Constrained_Array_Type; - - function New_Unsigned_Type (Size : Natural) return O_Tnode - is - subtype O_Tnode_Unsigned is O_Tnode_Type (ON_Unsigned_Type); - begin - return new O_Tnode_Unsigned'(Kind => ON_Unsigned_Type, - Decl => O_Dnode_Null, - Uncomplete => False, - Complete => True, - Int_Size => Size); - end New_Unsigned_Type; - - function New_Signed_Type (Size : Natural) return O_Tnode - is - subtype O_Tnode_Signed is O_Tnode_Type (ON_Signed_Type); - begin - return new O_Tnode_Signed'(Kind => ON_Signed_Type, - Decl => O_Dnode_Null, - Uncomplete => False, - Complete => True, - Int_Size => Size); - end New_Signed_Type; - - function New_Float_Type return O_Tnode - is - subtype O_Tnode_Float is O_Tnode_Type (ON_Float_Type); - begin - return new O_Tnode_Float'(Kind => ON_Float_Type, - Decl => O_Dnode_Null, - Uncomplete => False, - Complete => True); - end New_Float_Type; - - procedure New_Boolean_Type (Res : out O_Tnode; - False_Id : O_Ident; - False_E : out O_Cnode; - True_Id : O_Ident; - True_E : out O_Cnode) - is - subtype O_Tnode_Boolean is O_Tnode_Type (ON_Boolean_Type); - subtype O_Cnode_Boolean_Lit is O_Cnode_Type (OC_Boolean_Lit); - begin - Res := new O_Tnode_Boolean'(Kind => ON_Boolean_Type, - Decl => O_Dnode_Null, - Uncomplete => False, - Complete => True, - True_N => O_Cnode_Null, - False_N => O_Cnode_Null); - True_E := new O_Cnode_Boolean_Lit'(Kind => OC_Boolean_Lit, - Ctype => Res, - Ref => False, - B_Val => True, - B_Id => True_Id); - False_E := new O_Cnode_Boolean_Lit'(Kind => OC_Boolean_Lit, - Ctype => Res, - Ref => False, - B_Val => False, - B_Id => False_Id); - Res.True_N := True_E; - Res.False_N := False_E; - end New_Boolean_Type; - - procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural) - is - pragma Unreferenced (Size); - subtype O_Tnode_Enum is O_Tnode_Type (ON_Enum_Type); - Res : O_Tnode; - begin - Res := new O_Tnode_Enum'(Kind => ON_Enum_Type, - Decl => O_Dnode_Null, - Uncomplete => False, - Complete => False, - Nbr => 0, - Literals => O_Cnode_Null); - List.Res := Res; - List.Last := O_Cnode_Null; - end Start_Enum_Type; - - procedure New_Enum_Literal (List : in out O_Enum_List; - Ident : O_Ident; - Res : out O_Cnode) - is - subtype O_Cnode_Enum_Lit is O_Cnode_Type (OC_Enum_Lit); - begin - Res := new O_Cnode_Enum_Lit'(Kind => OC_Enum_Lit, - Ctype => List.Res, - Ref => False, - E_Val => List.Res.Nbr, - E_Name => Ident, - E_Next => O_Cnode_Null); - -- Link it. - if List.Last = O_Cnode_Null then - List.Res.Literals := Res; - else - List.Last.E_Next := Res; - end if; - List.Last := Res; - - List.Res.Nbr := List.Res.Nbr + 1; - end New_Enum_Literal; - - procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode) is - begin - Res := List.Res; - Res.Complete := True; - end Finish_Enum_Type; - - function Get_Base_Type (Atype : O_Tnode) return O_Tnode - is - begin - case Atype.Kind is - when ON_Array_Sub_Type => - return Atype.Base_Type; - when others => - return Atype; - end case; - end Get_Base_Type; - - procedure Start_Record_Aggr (List : out O_Record_Aggr_List; Atype : O_Tnode) - is - subtype O_Cnode_Aggregate is O_Cnode_Type (OC_Aggregate); - Res : O_Cnode; - begin - if Atype.Kind /= ON_Record_Type then - raise Type_Error; - end if; - Check_Complete_Type (Atype); - Res := new O_Cnode_Aggregate'(Kind => OC_Aggregate, - Ctype => Atype, - Ref => False, - Aggr_Els => null); - List.Res := Res; - List.Last := null; - List.Field := Atype.Elements; - end Start_Record_Aggr; - - procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List; - Value : O_Cnode) - is - subtype O_Cnode_Aggrel_Type is O_Cnode_Type (OC_Aggr_Element); - El : O_Cnode; - begin - if List.Field = O_Fnode_Null then - -- No more element in the aggregate. - raise Syntax_Error; - end if; - Check_Type (Value.Ctype, List.Field.Ftype); - El := new O_Cnode_Aggrel_Type'(Kind => OC_Aggr_Element, - Ctype => Value.Ctype, - Ref => False, - Aggr_Value => Value, - Aggr_Next => null); - if List.Last = null then - List.Res.Aggr_Els := El; - else - List.Last.Aggr_Next := El; - end if; - List.Last := El; - List.Field := List.Field.Next; - end New_Record_Aggr_El; - - procedure Finish_Record_Aggr - (List : in out O_Record_Aggr_List; Res : out O_Cnode) - is - begin - if List.Field /= null then - -- Not enough elements in aggregate. - raise Type_Error; - end if; - Res := List.Res; - end Finish_Record_Aggr; - - procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode) - is - subtype O_Cnode_Aggregate is O_Cnode_Type (OC_Aggregate); - Res : O_Cnode; - begin - if Atype.Kind /= ON_Array_Sub_Type then - raise Type_Error; - end if; - Check_Complete_Type (Atype); - Res := new O_Cnode_Aggregate'(Kind => OC_Aggregate, - Ctype => Atype, - Ref => False, - Aggr_Els => null); - List.Res := Res; - List.Last := null; - List.El_Type := Atype.Base_Type.El_Type; - end Start_Array_Aggr; - - procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List; - Value : O_Cnode) - is - subtype O_Cnode_Aggrel_Type is O_Cnode_Type (OC_Aggr_Element); - El : O_Cnode; - begin - Check_Type (Value.Ctype, List.El_Type); - El := new O_Cnode_Aggrel_Type'(Kind => OC_Aggr_Element, - Ctype => Value.Ctype, - Ref => False, - Aggr_Value => Value, - Aggr_Next => null); - if List.Last = null then - List.Res.Aggr_Els := El; - else - List.Last.Aggr_Next := El; - end if; - List.Last := El; - end New_Array_Aggr_El; - - procedure Finish_Array_Aggr - (List : in out O_Array_Aggr_List; Res : out O_Cnode) is - begin - Res := List.Res; - end Finish_Array_Aggr; - - function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode) - return O_Cnode - is - subtype O_Cnode_Union_Aggr is O_Cnode_Type (OC_Union_Aggr); - Res : O_Cnode; - begin - if Atype.Kind /= ON_Union_Type then - raise Type_Error; - end if; - Check_Type (Value.Ctype, Field.Ftype); - - Res := new O_Cnode_Union_Aggr'(Kind => OC_Union_Aggr, - Ctype => Atype, - Ref => False, - Uaggr_Field => Field, - Uaggr_Value => Value); - return Res; - end New_Union_Aggr; - - function New_Obj (Obj : O_Dnode) return O_Lnode - is - subtype O_Lnode_Obj is O_Lnode_Type (OL_Obj); - begin - case Obj.Kind is - when ON_Const_Decl - | ON_Var_Decl - | ON_Interface_Decl => - null; - when others => - raise Program_Error; - end case; - Check_Scope (Obj); - return new O_Lnode_Obj'(Kind => OL_Obj, - Rtype => Obj.Dtype, - Ref => False, - Obj => Obj); - end New_Obj; - - function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode) - return O_Lnode - is - subtype O_Lnode_Indexed is O_Lnode_Type (OL_Indexed_Element); - Res : O_Lnode; - begin - Check_Ref (Arr); - Res := new O_Lnode_Indexed'(Kind => OL_Indexed_Element, - Rtype => Get_Base_Type (Arr.Rtype).El_Type, - Ref => False, - Array_Base => Arr, - Index => Index); - return Res; - end New_Indexed_Element; - - function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode) - return O_Lnode - is - subtype O_Lnode_Slice is O_Lnode_Type (OL_Slice); - Res : O_Lnode; - begin - if Res_Type.Kind /= ON_Array_Type - and then Res_Type.Kind /= ON_Array_Sub_Type - then - raise Type_Error; - end if; - Check_Ref (Arr); - Check_Ref (Index); - -- FIXME: check type. - Res := new O_Lnode_Slice'(Kind => OL_Slice, - Rtype => Res_Type, - Ref => False, - Slice_Base => Arr, - Slice_Index => Index); - return Res; - end New_Slice; - - function New_Selected_Element (Rec : O_Lnode; El : O_Fnode) - return O_Lnode - is - subtype O_Lnode_Selected_Element is O_Lnode_Type (OL_Selected_Element); - begin - if Rec.Rtype.Kind /= ON_Record_Type then - raise Type_Error; - end if; - if Rec.Rtype /= El.Parent then - raise Type_Error; - end if; - Check_Ref (Rec); - return new O_Lnode_Selected_Element'(Kind => OL_Selected_Element, - Rtype => El.Ftype, - Ref => False, - Rec_Base => Rec, - Rec_El => El); - end New_Selected_Element; - - function New_Access_Element (Acc : O_Enode) return O_Lnode - is - subtype O_Lnode_Access_Element is O_Lnode_Type (OL_Access_Element); - begin - if Acc.Rtype.Kind /= ON_Access_Type then - raise Type_Error; - end if; - Check_Ref (Acc); - return new O_Lnode_Access_Element'(Kind => OL_Access_Element, - Rtype => Acc.Rtype.D_Type, - Ref => False, - Acc_Base => Acc); - end New_Access_Element; - - function Check_Conv (Source : ON_Type_Kind; Target : ON_Type_Kind) - return Boolean - is - type Conv_Array is array (ON_Type_Kind, ON_Type_Kind) of Boolean; - T : constant Boolean := True; - F : constant Boolean := False; - Conv_Allowed : constant Conv_Array := - (ON_Boolean_Type => (T, F, T, T, F, F, F, F, F, F), - ON_Enum_Type => (F, F, T, T, F, F, F, F, F, F), - ON_Unsigned_Type => (T, T, T, T, F, F, F, F, F, F), - ON_Signed_Type => (T, T, T, T, T, F, F, F, F, F), - ON_Float_Type => (F, F, F, T, T, F, F, F, F, F), - ON_Array_Type => (F, F, F, F, F, F, T, F, F, F), - ON_Array_Sub_Type =>(F, F, F, F, F, T, T, F, F, F), - ON_Record_Type => (F, F, F, F, F, F, F, F, F, F), - ON_Union_Type => (F, F, F, F, F, F, F, F, F, F), - ON_Access_Type => (F, F, F, F, F, F, F, F, F, T)); - begin - if Source = Target then - return True; - else - return Conv_Allowed (Source, Target); - end if; - end Check_Conv; - - function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode - is - subtype O_Enode_Convert is O_Enode_Type (OE_Convert_Ov); - Res : O_Enode; - begin - Check_Ref (Val); - if not Check_Conv (Val.Rtype.Kind, Rtype.Kind) then - raise Type_Error; - end if; - Res := new O_Enode_Convert'(Kind => OE_Convert_Ov, - Rtype => Rtype, - Ref => False, - Conv => Val); - return Res; - end New_Convert_Ov; - - function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode) - return O_Enode - is - subtype O_Enode_Address is O_Enode_Type (OE_Unchecked_Address); - begin - Check_Ref (Lvalue); - if Atype.Kind /= ON_Access_Type then - -- An address is of type access. - raise Type_Error; - end if; - return new O_Enode_Address'(Kind => OE_Unchecked_Address, - Rtype => Atype, - Ref => False, - Lvalue => Lvalue); - end New_Unchecked_Address; - - function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode - is - subtype O_Enode_Address is O_Enode_Type (OE_Address); - begin - Check_Ref (Lvalue); - if Atype.Kind /= ON_Access_Type then - -- An address is of type access. - raise Type_Error; - end if; - if Get_Base_Type (Lvalue.Rtype) /= Get_Base_Type (Atype.D_Type) then - if not Disable_Checks then - raise Type_Error; - end if; - end if; - return new O_Enode_Address'(Kind => OE_Address, - Rtype => Atype, - Ref => False, - Lvalue => Lvalue); - end New_Address; - - function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode) - return O_Cnode - is - subtype O_Cnode_Address is O_Cnode_Type (OC_Unchecked_Address); - begin - Check_Scope (Decl); - if Atype.Kind /= ON_Access_Type then - -- An address is of type access. - raise Type_Error; - end if; - return new O_Cnode_Address'(Kind => OC_Unchecked_Address, - Ctype => Atype, - Ref => False, - Decl => Decl); - end New_Global_Unchecked_Address; - - function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode) return O_Cnode - is - subtype O_Cnode_Address is O_Cnode_Type (OC_Address); - begin - Check_Scope (Decl); - if Atype.Kind /= ON_Access_Type then - -- An address is of type access. - raise Type_Error; - end if; - if Get_Base_Type (Decl.Dtype) /= Get_Base_Type (Atype.D_Type) then - raise Type_Error; - end if; - return new O_Cnode_Address'(Kind => OC_Address, - Ctype => Atype, - Ref => False, - Decl => Decl); - end New_Global_Address; - - function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode) - return O_Cnode - is - subtype O_Cnode_Subprg_Address is O_Cnode_Type (OC_Subprogram_Address); - begin - if Atype.Kind /= ON_Access_Type then - -- An address is of type access. - raise Type_Error; - end if; - return new O_Cnode_Subprg_Address'(Kind => OC_Subprogram_Address, - Ctype => Atype, - Ref => False, - Decl => Subprg); - end New_Subprogram_Address; - - -- Raise TYPE_ERROR is ATYPE is a composite type. - procedure Check_Not_Composite (Atype : O_Tnode) is - begin - case Atype.Kind is - when ON_Boolean_Type - | ON_Unsigned_Type - | ON_Signed_Type - | ON_Float_Type - | ON_Enum_Type - | ON_Access_Type=> - return; - when ON_Array_Type - | ON_Record_Type - | ON_Union_Type - | ON_Array_Sub_Type => - raise Type_Error; - end case; - end Check_Not_Composite; - - function New_Value (Lvalue : O_Lnode) return O_Enode is - subtype O_Enode_Value is O_Enode_Type (OE_Value); - begin - Check_Not_Composite (Lvalue.Rtype); - Check_Ref (Lvalue); - return new O_Enode_Value'(Kind => OE_Value, - Rtype => Lvalue.Rtype, - Ref => False, - Value => Lvalue); - end New_Value; - - function New_Obj_Value (Obj : O_Dnode) return O_Enode is - begin - return New_Value (New_Obj (Obj)); - end New_Obj_Value; - - function New_Lit (Lit : O_Cnode) return O_Enode is - subtype O_Enode_Lit is O_Enode_Type (OE_Lit); - begin - Check_Not_Composite (Lit.Ctype); - return new O_Enode_Lit'(Kind => OE_Lit, - Rtype => Lit.Ctype, - Ref => False, - Lit => Lit); - end New_Lit; - - --------------------- - -- Declarations. -- - --------------------- - - procedure New_Debug_Filename_Decl (Filename : String) - is - subtype O_Dnode_Filename_Decl is O_Dnode_Type (ON_Debug_Filename_Decl); - N : O_Dnode; - begin - N := new O_Dnode_Filename_Decl; - N.Filename := new String'(Filename); - Add_Decl (N, False); - end New_Debug_Filename_Decl; - - procedure New_Debug_Line_Decl (Line : Natural) - is - subtype O_Dnode_Line_Decl is O_Dnode_Type (ON_Debug_Line_Decl); - N : O_Dnode; - begin - N := new O_Dnode_Line_Decl; - N.Line := Line; - Add_Decl (N, False); - end New_Debug_Line_Decl; - - procedure New_Debug_Comment_Decl (Comment : String) - is - subtype O_Dnode_Comment_Decl is O_Dnode_Type (ON_Debug_Comment_Decl); - N : O_Dnode; - begin - N := new O_Dnode_Comment_Decl; - N.Comment := new String'(Comment); - Add_Decl (N, False); - end New_Debug_Comment_Decl; - - procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode) - is - N : O_Dnode; - begin - if Atype.Decl /= null then - -- Type was already declared. - raise Type_Error; - end if; - N := new O_Dnode_Type (ON_Type_Decl); - N.Name := Ident; - N.Dtype := Atype; - Atype.Decl := N; - Add_Decl (N); - end New_Type_Decl; - - procedure Check_Object_Storage (Storage : O_Storage) is - begin - if Current_Function /= null then - -- Inside a subprogram. - case Storage is - when O_Storage_Public => - -- Cannot create public variables inside a subprogram. - raise Syntax_Error; - when O_Storage_Private - | O_Storage_Local - | O_Storage_External => - null; - end case; - else - -- Global scope. - case Storage is - when O_Storage_Public - | O_Storage_Private - | O_Storage_External => - null; - when O_Storage_Local => - -- Cannot create a local variables outside a subprogram. - raise Syntax_Error; - end case; - end if; - end Check_Object_Storage; - - procedure New_Const_Decl - (Res : out O_Dnode; - Ident : O_Ident; - Storage : O_Storage; - Atype : O_Tnode) - is - subtype O_Dnode_Const is O_Dnode_Type (ON_Const_Decl); - begin - Check_Complete_Type (Atype); - if Storage = O_Storage_Local then - -- A constant cannot be local. - raise Syntax_Error; - end if; - Check_Object_Storage (Storage); - Res := new O_Dnode_Const'(Kind => ON_Const_Decl, - Name => Ident, - Next => null, - Dtype => Atype, - Storage => Storage, - Scope => Current_Decl_Scope.Parent, - Lineno => 0, - Const_Value => O_Dnode_Null); - Add_Decl (Res); - end New_Const_Decl; - - procedure Start_Const_Value (Const : in out O_Dnode) - is - subtype O_Dnode_Const_Value is O_Dnode_Type (ON_Const_Value); - N : O_Dnode; - begin - if Const.Const_Value /= O_Dnode_Null then - -- Constant already has a value. - raise Syntax_Error; - end if; - - if Const.Storage = O_Storage_External then - -- An external constant must not have a value. - raise Syntax_Error; - end if; - - -- FIXME: check scope is the same. - - N := new O_Dnode_Const_Value'(Kind => ON_Const_Value, - Name => Const.Name, - Next => null, - Dtype => Const.Dtype, - Storage => Const.Storage, - Scope => Current_Decl_Scope.Parent, - Lineno => 0, - Const_Decl => Const, - Value => O_Cnode_Null); - Const.Const_Value := N; - Add_Decl (N, False); - end Start_Const_Value; - - procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode) - is - begin - if Const.Const_Value = O_Dnode_Null then - -- Start_Const_Value not called. - raise Syntax_Error; - end if; - if Const.Const_Value.Value /= O_Cnode_Null then - -- Finish_Const_Value already called. - raise Syntax_Error; - end if; - if Val = O_Cnode_Null then - -- No value or bad type. - raise Type_Error; - end if; - Check_Type (Val.Ctype, Const.Dtype); - Const.Const_Value.Value := Val; - end Finish_Const_Value; - - procedure New_Var_Decl - (Res : out O_Dnode; - Ident : O_Ident; - Storage : O_Storage; - Atype : O_Tnode) - is - subtype O_Dnode_Var is O_Dnode_Type (ON_Var_Decl); - begin - Check_Complete_Type (Atype); - Check_Object_Storage (Storage); - Res := new O_Dnode_Var'(Kind => ON_Var_Decl, - Name => Ident, - Next => null, - Dtype => Atype, - Storage => Storage, - Lineno => 0, - Scope => Current_Decl_Scope.Parent); - Add_Decl (Res); - end New_Var_Decl; - - procedure Start_Subprogram_Decl_1 - (Interfaces : out O_Inter_List; - Ident : O_Ident; - Storage : O_Storage; - Rtype : O_Tnode) - is - subtype O_Dnode_Function is O_Dnode_Type (ON_Function_Decl); - N : O_Dnode; - begin - N := new O_Dnode_Function'(Kind => ON_Function_Decl, - Next => null, - Name => Ident, - Dtype => Rtype, - Storage => Storage, - Scope => Current_Decl_Scope.Parent, - Lineno => 0, - Interfaces => null, - Func_Body => null, - Alive => False); - Add_Decl (N); - Interfaces.Func := N; - Interfaces.Last := null; - end Start_Subprogram_Decl_1; - - procedure Start_Function_Decl - (Interfaces : out O_Inter_List; - Ident : O_Ident; - Storage : O_Storage; - Rtype : O_Tnode) - is - begin - Check_Not_Composite (Rtype); - Check_Complete_Type (Rtype); - Start_Subprogram_Decl_1 (Interfaces, Ident, Storage, Rtype); - end Start_Function_Decl; - - procedure Start_Procedure_Decl - (Interfaces : out O_Inter_List; - Ident : O_Ident; - Storage : O_Storage) is - begin - Start_Subprogram_Decl_1 (Interfaces, Ident, Storage, null); - end Start_Procedure_Decl; - - procedure New_Interface_Decl - (Interfaces : in out O_Inter_List; - Res : out O_Dnode; - Ident : O_Ident; - Atype : O_Tnode) - is - subtype O_Dnode_Interface is O_Dnode_Type (ON_Interface_Decl); - begin - Check_Not_Composite (Atype); - Check_Complete_Type (Atype); - Res := new O_Dnode_Interface'(Kind => ON_Interface_Decl, - Next => null, - Name => Ident, - Dtype => Atype, - Storage => O_Storage_Private, - Scope => Current_Decl_Scope.Parent, - Lineno => 0, - Func_Scope => Interfaces.Func); - if Interfaces.Last = null then - Interfaces.Func.Interfaces := Res; - else - Interfaces.Last.Next := Res; - end if; - Interfaces.Last := Res; - end New_Interface_Decl; - - procedure Finish_Subprogram_Decl - (Interfaces : in out O_Inter_List; Res : out O_Dnode) - is - begin - Res := Interfaces.Func; - end Finish_Subprogram_Decl; - - procedure Start_Subprogram_Body (Func : O_Dnode) - is - B : O_Dnode; - S : O_Snode; - begin - if Func.Func_Body /= null then - -- Function was already declared. - raise Syntax_Error; - end if; - S := new O_Snode_Type (ON_Declare_Stmt); - S.all := O_Snode_Type'(Kind => ON_Declare_Stmt, - Next => null, - Decls => null, - Stmts => null, - Lineno => 0, - Alive => True); - B := new O_Dnode_Type (ON_Function_Body); - B.all := O_Dnode_Type'(ON_Function_Body, - Name => Func.Name, - Dtype => Func.Dtype, - Storage => Func.Storage, - Scope => Current_Decl_Scope.Parent, - Lineno => 0, - Func_Decl => Func, - Func_Stmt => S, - Next => null); - Add_Decl (B, False); - Func.Func_Body := B; - Push_Decl_Scope (S); - Push_Stmt_Scope - (new Stmt_Function_Scope_Type'(Kind => Stmt_Function, - Parent => S, - Prev => Current_Stmt_Scope, - Prev_Function => Current_Function, - Decl => Func)); - Current_Function := Current_Stmt_Scope; - Func.Alive := True; - end Start_Subprogram_Body; - - procedure Finish_Subprogram_Body is - begin - Pop_Decl_Scope; - if Current_Function.Kind /= Stmt_Function then - -- Internal error. - raise Syntax_Error; - end if; - Current_Function.Decl.Alive := False; - Current_Function := Current_Function.Prev_Function; - Pop_Stmt_Scope (Stmt_Function); - end Finish_Subprogram_Body; - - ------------------- - -- Statements. -- - ------------------- - - procedure New_Debug_Line_Stmt (Line : Natural) - is - subtype O_Snode_Line_Stmt is O_Snode_Type (ON_Debug_Line_Stmt); - begin - Add_Stmt (new O_Snode_Line_Stmt'(Kind => ON_Debug_Line_Stmt, - Next => null, - Lineno => 0, - Line => Line)); - end New_Debug_Line_Stmt; - - procedure New_Debug_Comment_Stmt (Comment : String) - is - subtype O_Snode_Comment_Stmt is O_Snode_Type (ON_Debug_Comment_Stmt); - begin - Add_Stmt (new O_Snode_Comment_Stmt'(Kind => ON_Debug_Comment_Stmt, - Next => null, - Lineno => 0, - Comment => new String'(Comment))); - end New_Debug_Comment_Stmt; - - procedure Start_Declare_Stmt - is - N : O_Snode; - begin - N := new O_Snode_Type (ON_Declare_Stmt); - Add_Stmt (N); - Push_Decl_Scope (N); - Push_Stmt_Scope - (new Stmt_Declare_Scope_Type'(Kind => Stmt_Declare, - Parent => N, - Prev => Current_Stmt_Scope)); - end Start_Declare_Stmt; - - procedure Finish_Declare_Stmt is - begin - Pop_Decl_Scope; - Pop_Stmt_Scope (Stmt_Declare); - end Finish_Declare_Stmt; - - procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode) - is - N : O_Snode; - begin - Check_Type (Target.Rtype, Value.Rtype); - Check_Not_Composite (Target.Rtype); - Check_Ref (Target); - Check_Ref (Value); - N := new O_Snode_Type (ON_Assign_Stmt); - N.all := O_Snode_Type'(Kind => ON_Assign_Stmt, - Next => null, - Lineno => 0, - Target => Target, - Value => Value); - Add_Stmt (N); - end New_Assign_Stmt; - - procedure New_Return_Stmt_1 (Value : O_Enode) - is - subtype O_Snode_Return_Stmt is O_Snode_Type (ON_Return_Stmt); - N : O_Snode; - begin - N := new O_Snode_Return_Stmt'(Kind => ON_Return_Stmt, - Next => null, - Lineno => 0, - Ret_Val => Value); - Add_Stmt (N); - end New_Return_Stmt_1; - - procedure New_Return_Stmt (Value : O_Enode) - is - begin - if Current_Function = null - or else Current_Function.Decl.Dtype = O_Tnode_Null - then - -- Either not in a function or in a procedure. - raise Syntax_Error; - end if; - Check_Type (Value.Rtype, Current_Function.Decl.Dtype); - Check_Ref (Value); - New_Return_Stmt_1 (Value); - end New_Return_Stmt; - - procedure New_Return_Stmt is - begin - if Current_Function = null - or else Current_Function.Decl.Dtype /= O_Tnode_Null - then - -- Not in a procedure. - raise Syntax_Error; - end if; - New_Return_Stmt_1 (null); - end New_Return_Stmt; - - procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode) - is - begin - Check_Scope (Subprg); - Assocs.Subprg := Subprg; - Assocs.Interfaces := Subprg.Interfaces; - Assocs.First := null; - Assocs.Last := null; - end Start_Association; - - procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode) - is - N : O_Anode; - begin - Check_Type (Assocs.Interfaces.Dtype, Val.Rtype); - Check_Ref (Val); - N := new O_Anode_Type'(Next => null, - Formal => Assocs.Interfaces, Actual => Val); - Assocs.Interfaces := Assocs.Interfaces.Next; - if Assocs.Last = null then - Assocs.First := N; - else - Assocs.Last.Next := N; - end if; - Assocs.Last := N; - end New_Association; - - function New_Function_Call (Assocs : O_Assoc_List) return O_Enode - is - subtype O_Enode_Call is O_Enode_Type (OE_Function_Call); - Res : O_Enode; - begin - if Assocs.Interfaces /= null then - -- Not enough arguments. - raise Syntax_Error; - end if; - if Assocs.Subprg.Dtype = null then - -- This is a procedure. - raise Syntax_Error; - end if; - - Res := new O_Enode_Call'(Kind => OE_Function_Call, - Rtype => Assocs.Subprg.Dtype, - Ref => False, - Func => Assocs.Subprg, - Assoc => Assocs.First); - return Res; - end New_Function_Call; - - procedure New_Procedure_Call (Assocs : in out O_Assoc_List) - is - N : O_Snode; - begin - if Assocs.Interfaces /= null then - -- Not enough arguments. - raise Syntax_Error; - end if; - if Assocs.Subprg.Dtype /= null then - -- This is a function. - raise Syntax_Error; - end if; - N := new O_Snode_Type (ON_Call_Stmt); - N.Proc := Assocs.Subprg; - N.Assoc := Assocs.First; - Add_Stmt (N); - end New_Procedure_Call; - - procedure New_Elsif_Stmt (Block : in out O_If_Block; Cond : O_Enode); - - procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode) - is - subtype O_Snode_If is O_Snode_Type (ON_If_Stmt); - N : O_Snode; - begin - -- Note: no checks are performed here, since they are done in - -- new_elsif_stmt. - N := new O_Snode_If'(Kind => ON_If_Stmt, - Next => null, - Lineno => 0, - Elsifs => null, - If_Last => null); - Add_Stmt (N); - Push_Stmt_Scope (new Stmt_If_Scope_Type'(Kind => Stmt_If, - Parent => N, - Prev => Current_Stmt_Scope, - Last_Elsif => null)); - New_Elsif_Stmt (Block, Cond); - end Start_If_Stmt; - - procedure New_Elsif_Stmt (Block : in out O_If_Block; Cond : O_Enode) - is - pragma Unreferenced (Block); - N : O_Snode; - begin - if Cond /= null then - if Cond.Rtype.Kind /= ON_Boolean_Type then - raise Type_Error; - end if; - Check_Ref (Cond); - end if; - N := new O_Snode_Type (ON_Elsif_Stmt); - N.all := O_Snode_Type'(Kind => ON_Elsif_Stmt, - Next => null, - Lineno => 0, - Cond => Cond, - Next_Elsif => null); - if Current_Stmt_Scope.Kind /= Stmt_If then - raise Syntax_Error; - end if; - Add_Stmt (N); - if Current_Stmt_Scope.Last_Elsif = null then - Current_Stmt_Scope.Parent.Elsifs := N; - else - -- Check for double 'else' - if Current_Stmt_Scope.Last_Elsif.Cond = null then - raise Syntax_Error; - end if; - Current_Stmt_Scope.Last_Elsif.Next_Elsif := N; - end if; - Current_Stmt_Scope.Last_Elsif := N; - end New_Elsif_Stmt; - - procedure New_Else_Stmt (Block : in out O_If_Block) is - begin - New_Elsif_Stmt (Block, null); - end New_Else_Stmt; - - procedure Finish_If_Stmt (Block : in out O_If_Block) - is - pragma Unreferenced (Block); - Parent : O_Snode; - begin - Parent := Current_Stmt_Scope.Parent; - Pop_Stmt_Scope (Stmt_If); - Parent.If_Last := Current_Decl_Scope.Last_Stmt; - end Finish_If_Stmt; - - procedure Start_Loop_Stmt (Label : out O_Snode) - is - subtype O_Snode_Loop_Type is O_Snode_Type (ON_Loop_Stmt); - begin - Current_Loop_Level := Current_Loop_Level + 1; - Label := new O_Snode_Loop_Type'(Kind => ON_Loop_Stmt, - Next => null, - Lineno => 0, - Loop_Last => null, - Loop_Level => Current_Loop_Level); - Add_Stmt (Label); - Push_Stmt_Scope (new Stmt_Loop_Scope_Type'(Kind => Stmt_Loop, - Parent => Label, - Prev => Current_Stmt_Scope)); - end Start_Loop_Stmt; - - procedure Finish_Loop_Stmt (Label : in out O_Snode) - is - pragma Unreferenced (Label); - Parent : O_Snode; - begin - Parent := Current_Stmt_Scope.Parent; - Pop_Stmt_Scope (Stmt_Loop); - Parent.Loop_Last := Current_Decl_Scope.Last_Stmt; - Current_Loop_Level := Current_Loop_Level - 1; - end Finish_Loop_Stmt; - - procedure New_Exit_Next_Stmt (Kind : ON_Stmt_Kind; L : O_Snode) - is - N : O_Snode; - begin - N := new O_Snode_Type (Kind); - N.Next := null; - N.Loop_Id := L; - Add_Stmt (N); - end New_Exit_Next_Stmt; - - procedure New_Exit_Stmt (L : O_Snode) is - begin - New_Exit_Next_Stmt (ON_Exit_Stmt, L); - end New_Exit_Stmt; - - procedure New_Next_Stmt (L : O_Snode) is - begin - New_Exit_Next_Stmt (ON_Next_Stmt, L); - end New_Next_Stmt; - - procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode) - is - subtype O_Snode_Case_Type is O_Snode_Type (ON_Case_Stmt); - N : O_Snode; - begin - case Value.Rtype.Kind is - when ON_Boolean_Type - | ON_Unsigned_Type - | ON_Signed_Type - | ON_Enum_Type => - null; - when others => - raise Type_Error; - end case; - Check_Ref (Value); - N := new O_Snode_Case_Type'(Kind => ON_Case_Stmt, - Next => null, - Lineno => 0, - Case_Last => null, - Selector => Value, - Branches => null); - Block.Case_Stmt := N; - Add_Stmt (N); - Push_Stmt_Scope (new Stmt_Case_Scope_Type'(Kind => Stmt_Case, - Parent => N, - Prev => Current_Stmt_Scope, - Last_Branch => null, - Last_Choice => null, - Case_Type => Value.Rtype)); - end Start_Case_Stmt; - - procedure Start_Choice (Block : in out O_Case_Block) - is - N : O_Snode; - begin - if Current_Stmt_Scope.Kind /= Stmt_Case then - -- You are adding a branch outside a case statment. - raise Syntax_Error; - end if; - if Current_Stmt_Scope.Last_Choice /= null then - -- You are creating branch while the previous one was not finished. - raise Syntax_Error; - end if; - - N := new O_Snode_Type (ON_When_Stmt); - N.all := O_Snode_Type'(Kind => ON_When_Stmt, - Next => null, - Lineno => 0, - Branch_Parent => Block.Case_Stmt, - Choice_List => null, - Next_Branch => null); - if Current_Stmt_Scope.Last_Branch = null then - Current_Stmt_Scope.Parent.Branches := N; - else - Current_Stmt_Scope.Last_Branch.Next_Branch := N; - end if; - Current_Stmt_Scope.Last_Branch := N; - Current_Stmt_Scope.Last_Choice := null; - Add_Stmt (N); - end Start_Choice; - - procedure Add_Choice (Block : in out O_Case_Block; Choice : O_Choice) - is - pragma Unreferenced (Block); - begin - if Current_Stmt_Scope.Kind /= Stmt_Case then - -- You are adding a choice not inside a case statement. - raise Syntax_Error; - end if; - if Current_Stmt_Scope.Last_Branch = null then - -- You are not inside a branch. - raise Syntax_Error; - end if; - if Current_Stmt_Scope.Last_Choice = null then - if Current_Stmt_Scope.Last_Branch.Choice_List /= null then - -- The branch was already closed. - raise Syntax_Error; - end if; - Current_Stmt_Scope.Last_Branch.Choice_List := Choice; - else - Current_Stmt_Scope.Last_Choice.Next := Choice; - end if; - Current_Stmt_Scope.Last_Choice := Choice; - end Add_Choice; - - procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode) - is - N : O_Choice; - begin - if Current_Stmt_Scope.Kind /= Stmt_Case then - -- You are creating a choice not inside a case statement. - raise Syntax_Error; - end if; - if Current_Stmt_Scope.Case_Type /= Expr.Ctype then - -- Expr type is not the same as choice type. - raise Type_Error; - end if; - - N := new O_Choice_Type (ON_Choice_Expr); - N.all := O_Choice_Type'(Kind => ON_Choice_Expr, - Next => null, - Expr => Expr); - Add_Choice (Block, N); - end New_Expr_Choice; - - procedure New_Range_Choice (Block : in out O_Case_Block; - Low, High : O_Cnode) - is - N : O_Choice; - begin - if Current_Stmt_Scope.Kind /= Stmt_Case then - -- You are creating a choice not inside a case statement. - raise Syntax_Error; - end if; - if Current_Stmt_Scope.Case_Type /= Low.Ctype - or Current_Stmt_Scope.Case_Type /= High.Ctype - then - -- Low/High type is not the same as choice type. - raise Type_Error; - end if; - - N := new O_Choice_Type (ON_Choice_Range); - N.all := O_Choice_Type'(Kind => ON_Choice_Range, - Next => null, - Low => Low, - High => High); - Add_Choice (Block, N); - end New_Range_Choice; - - procedure New_Default_Choice (Block : in out O_Case_Block) - is - N : O_Choice; - begin - if Current_Stmt_Scope.Kind /= Stmt_Case then - -- You are creating a choice not inside a case statement. - raise Syntax_Error; - end if; - - N := new O_Choice_Type (ON_Choice_Default); - N.all := O_Choice_Type'(Kind => ON_Choice_Default, - Next => null); - Add_Choice (Block, N); - end New_Default_Choice; - - procedure Finish_Choice (Block : in out O_Case_Block) - is - pragma Unreferenced (Block); - begin - if Current_Stmt_Scope.Kind /= Stmt_Case then - -- You are adding a choice not inside a case statement. - raise Syntax_Error; - end if; - if Current_Stmt_Scope.Last_Branch = null then - -- You are not inside a branch. - raise Syntax_Error; - end if; - if Current_Stmt_Scope.Last_Choice = null then - -- The branch is empty or you are not inside a branch. - raise Syntax_Error; - end if; - Current_Stmt_Scope.Last_Choice := null; - end Finish_Choice; - - procedure Finish_Case_Stmt (Block : in out O_Case_Block) - is - pragma Unreferenced (Block); - Parent : O_Snode; - begin - Parent := Current_Stmt_Scope.Parent; - Pop_Stmt_Scope (Stmt_Case); - Parent.Case_Last := Current_Decl_Scope.Last_Stmt; - end Finish_Case_Stmt; - - procedure Init is - begin - Top := new O_Snode_Type (ON_Declare_Stmt); - Push_Decl_Scope (Top); - end Init; - - procedure Finish is - begin - Pop_Decl_Scope; - end Finish; -end Ortho_Debug; diff --git a/ortho/debug/ortho_debug.private.ads b/ortho/debug/ortho_debug.private.ads deleted file mode 100644 index 69ee16cf7..000000000 --- a/ortho/debug/ortho_debug.private.ads +++ /dev/null @@ -1,467 +0,0 @@ --- Ortho debug back-end declarations. --- Copyright (C) 2005-2014 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GCC; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Interfaces; use Interfaces; -with Ortho_Ident; -use Ortho_Ident; - --- Interface to create nodes. -package Ortho_Debug is - procedure Init; - procedure Finish; - -private - -- This back-end supports nested subprograms. - Has_Nested_Subprograms : constant Boolean := True; - - -- A node for a type. - type O_Tnode_Type (<>); - type O_Tnode is access O_Tnode_Type; - - -- A node for a statement. - type O_Snode_Type (<>); - type O_Snode is access O_Snode_Type; - - Top : O_Snode; - - type Str_Acc is access String; - - type Decl_Scope_Type; - type Decl_Scope_Acc is access Decl_Scope_Type; - - type On_Decl_Kind is - (ON_Type_Decl, ON_Completed_Type_Decl, - ON_Const_Decl, ON_Var_Decl, ON_Interface_Decl, - ON_Function_Decl, ON_Function_Body, - ON_Const_Value, - ON_Debug_Line_Decl, ON_Debug_Comment_Decl, ON_Debug_Filename_Decl); - - type O_Dnode_Type (<>); - type O_Dnode is access O_Dnode_Type; - - O_Dnode_Null : constant O_Dnode := null; - - type O_Dnode_Type (Kind : On_Decl_Kind) is record - Next : O_Dnode; - Name : O_Ident; - Dtype : O_Tnode; - Storage : O_Storage; - -- Declare statement in which the declaration appears. - Scope : O_Snode; - -- Line number, for regen. - Lineno : Natural; - case Kind is - when ON_Type_Decl => - null; - when ON_Completed_Type_Decl => - null; - when ON_Const_Decl => - Const_Value : O_Dnode; - when ON_Const_Value => - Const_Decl : O_Dnode; - Value : O_Cnode; - when ON_Var_Decl => - null; - when ON_Function_Decl => - Interfaces : O_Dnode; - Func_Body : O_Dnode; - Alive : Boolean; - when ON_Function_Body => - Func_Decl : O_Dnode; - Func_Stmt : O_Snode; - when ON_Interface_Decl => - Func_Scope : O_Dnode; - when ON_Debug_Line_Decl => - Line : Natural; - when ON_Debug_Comment_Decl => - Comment : Str_Acc; - when ON_Debug_Filename_Decl => - Filename : Str_Acc; - end case; - end record; - - -- A node for a record element. - type O_Fnode_Type; - type O_Fnode is access O_Fnode_Type; - - O_Fnode_Null : constant O_Fnode := null; - - type O_Fnode_Type is record - -- Record type. - Parent : O_Tnode; - -- Next field in the record. - Next : O_Fnode; - -- Name of the record field. - Ident : O_Ident; - -- Type of the record field. - Ftype : O_Tnode; - -- Offset in the field. - Offset : Unsigned_32; - end record; - - type O_Anode_Type; - type O_Anode is access O_Anode_Type; - type O_Anode_Type is record - Next : O_Anode; - Formal : O_Dnode; - Actual : O_Enode; - end record; - - type OC_Kind is - ( - OC_Boolean_Lit, - OC_Unsigned_Lit, - OC_Signed_Lit, - OC_Float_Lit, - OC_Enum_Lit, - OC_Null_Lit, - OC_Sizeof_Lit, - OC_Alignof_Lit, - OC_Offsetof_Lit, - OC_Aggregate, - OC_Aggr_Element, - OC_Union_Aggr, - OC_Address, - OC_Unchecked_Address, - OC_Subprogram_Address - ); - type O_Cnode_Type (Kind : OC_Kind) is record - -- Type of the constant. - Ctype : O_Tnode; - -- True if referenced. - Ref : Boolean; - case Kind is - when OC_Unsigned_Lit => - U_Val : Unsigned_64; - when OC_Signed_Lit => - S_Val : Integer_64; - when OC_Float_Lit => - F_Val : IEEE_Float_64; - when OC_Boolean_Lit => - B_Val : Boolean; - B_Id : O_Ident; - when OC_Enum_Lit => - E_Val : Integer; - E_Next : O_Cnode; - E_Name : O_Ident; - when OC_Null_Lit => - null; - when OC_Sizeof_Lit - | OC_Alignof_Lit => - S_Type : O_Tnode; - when OC_Offsetof_Lit => - Off_Field : O_Fnode; - when OC_Aggregate => - Aggr_Els : O_Cnode; - when OC_Union_Aggr => - Uaggr_Field : O_Fnode; - Uaggr_Value : O_Cnode; - when OC_Aggr_Element => - Aggr_Value : O_Cnode; - Aggr_Next : O_Cnode; - when OC_Address - | OC_Unchecked_Address - | OC_Subprogram_Address => - Decl : O_Dnode; - end case; - end record; - - type O_Cnode is access O_Cnode_Type; - O_Cnode_Null : constant O_Cnode := null; - - type OE_Kind is - ( - -- Literals. - OE_Lit, - - -- Dyadic operations. - OE_Add_Ov, -- OE_Dyadic_Op_Kind - OE_Sub_Ov, -- OE_Dyadic_Op_Kind - OE_Mul_Ov, -- OE_Dyadic_Op_Kind - OE_Div_Ov, -- OE_Dyadic_Op_Kind - OE_Rem_Ov, -- OE_Dyadic_Op_Kind - OE_Mod_Ov, -- OE_Dyadic_Op_Kind - OE_Exp_Ov, -- OE_Dyadic_Op_Kind - - -- Binary operations. - OE_And, -- OE_Dyadic_Op_Kind - OE_Or, -- OE_Dyadic_Op_Kind - OE_Xor, -- OE_Dyadic_Op_Kind - OE_And_Then, -- OE_Dyadic_Op_Kind - OE_Or_Else, -- OE_Dyadic_Op_Kind - - -- Monadic operations. - OE_Not, -- OE_Monadic_Op_Kind - OE_Neg_Ov, -- OE_Monadic_Op_Kind - OE_Abs_Ov, -- OE_Monadic_Op_Kind - - -- Comparaisons - OE_Eq, -- OE_Compare_Op_Kind - OE_Neq, -- OE_Compare_Op_Kind - OE_Le, -- OE_Compare_Op_Kind - OE_Lt, -- OE_Compare_Op_Kind - OE_Ge, -- OE_Compare_Op_Kind - OE_Gt, -- OE_Compare_Op_Kind - - -- Misc. - OE_Convert_Ov, - OE_Address, - OE_Unchecked_Address, - OE_Alloca, - OE_Function_Call, - - OE_Value, - OE_Nil - ); - - subtype OE_Dyadic_Expr_Kind is OE_Kind range OE_Add_Ov .. OE_Or_Else; - subtype OE_Monadic_Expr_Kind is OE_Kind range OE_Not .. OE_Abs_Ov; - subtype OE_Compare_Expr_Kind is OE_Kind range OE_Eq .. OE_Gt; - - type O_Enode_Type (Kind : OE_Kind); - type O_Enode is access O_Enode_Type; - O_Enode_Null : constant O_Enode := null; - - type O_Enode_Type (Kind : OE_Kind) is record - -- Type of the result. - Rtype : O_Tnode; - -- True if referenced. - Ref : Boolean; - case Kind is - when OE_Dyadic_Expr_Kind - | OE_Compare_Expr_Kind => - Left : O_Enode; - Right : O_Enode; - when OE_Monadic_Expr_Kind => - Operand : O_Enode; - when OE_Lit => - Lit : O_Cnode; - when OE_Address - | OE_Unchecked_Address => - Lvalue : O_Lnode; - when OE_Convert_Ov => - Conv : O_Enode; - when OE_Function_Call => - Func : O_Dnode; - Assoc : O_Anode; - when OE_Value => - Value : O_Lnode; - when OE_Alloca => - A_Size : O_Enode; - when OE_Nil => - null; - end case; - end record; - type O_Enode_Array is array (Natural range <>) of O_Enode; - type O_Enode_Array_Acc is access O_Enode_Array; - - type OL_Kind is - ( - -- Name. - OL_Obj, - OL_Indexed_Element, - OL_Slice, - OL_Selected_Element, - OL_Access_Element - - -- Variable, constant, parameter reference. - -- This allows to read/write a declaration. - --OL_Var_Ref, - --OL_Const_Ref, - --OL_Param_Ref - ); - - type O_Lnode_Type (Kind : OL_Kind); - type O_Lnode is access O_Lnode_Type; - O_Lnode_Null : constant O_Lnode := null; - - type O_Lnode_Type (Kind : OL_Kind) is record - -- Type of the result. - Rtype : O_Tnode; - -- True if referenced. - Ref : Boolean; - case Kind is - when OL_Obj => - Obj : O_Dnode; - when OL_Indexed_Element => - Array_Base : O_Lnode; - Index : O_Enode; - when OL_Slice => - Slice_Base : O_Lnode; - Slice_Index : O_Enode; - when OL_Selected_Element => - Rec_Base : O_Lnode; - Rec_El : O_Fnode; - when OL_Access_Element => - Acc_Base : O_Enode; --- when OL_Var_Ref --- | OL_Const_Ref --- | OL_Param_Ref => --- Decl : O_Dnode; - end case; - end record; - - O_Tnode_Null : constant O_Tnode := null; - type ON_Type_Kind is - (ON_Boolean_Type, ON_Enum_Type, - ON_Unsigned_Type, ON_Signed_Type, ON_Float_Type, ON_Array_Type, - ON_Array_Sub_Type, ON_Record_Type, ON_Union_Type, ON_Access_Type); - type O_Tnode_Type (Kind : ON_Type_Kind) is record - Decl : O_Dnode; - -- True if the type was first created as an uncomplete type. - Uncomplete : Boolean; - -- True if the type is complete. - Complete : Boolean; - case Kind is - when ON_Boolean_Type => - True_N : O_Cnode; - False_N : O_Cnode; - when ON_Unsigned_Type - | ON_Signed_Type => - Int_Size : Natural; - when ON_Float_Type => - null; - when ON_Enum_Type => - Nbr : Natural; - Literals: O_Cnode; - when ON_Array_Type => - El_Type : O_Tnode; - Index_Type : O_Tnode; - when ON_Access_Type => - D_Type : O_Tnode; - when ON_Record_Type - | ON_Union_Type => - Elements : O_Fnode; - when ON_Array_Sub_Type => - Length : O_Cnode; - Base_Type : O_Tnode; - end case; - end record; - - type ON_Choice_Kind is (ON_Choice_Expr, ON_Choice_Range, ON_Choice_Default); - type O_Choice_Type (Kind : ON_Choice_Kind); - type O_Choice is access O_Choice_Type; - type O_Choice_Type (Kind : ON_Choice_Kind) is record - Next : O_Choice; - case Kind is - when ON_Choice_Expr => - Expr : O_Cnode; - when ON_Choice_Range => - Low, High : O_Cnode; - when ON_Choice_Default => - null; - end case; - end record; - - O_Snode_Null : constant O_Snode := null; - type ON_Stmt_Kind is - (ON_Declare_Stmt, ON_Assign_Stmt, ON_Return_Stmt, ON_If_Stmt, - ON_Elsif_Stmt, ON_Loop_Stmt, ON_Exit_Stmt, ON_Next_Stmt, - ON_Case_Stmt, ON_When_Stmt, ON_Call_Stmt, - ON_Debug_Line_Stmt, ON_Debug_Comment_Stmt); - type O_Snode_Type (Kind : ON_Stmt_Kind) is record - Next : O_Snode; - Lineno : Natural; - case Kind is - when ON_Declare_Stmt => - Decls : O_Dnode; - Stmts : O_Snode; - -- True if the statement is currently open. - Alive : Boolean; - when ON_Assign_Stmt => - Target : O_Lnode; - Value : O_Enode; - when ON_Return_Stmt => - Ret_Val : O_Enode; - when ON_If_Stmt => - Elsifs : O_Snode; - If_Last : O_Snode; - when ON_Elsif_Stmt => - Cond : O_Enode; - Next_Elsif : O_Snode; - when ON_Loop_Stmt => - Loop_Last : O_Snode; - Loop_Level : Natural; - when ON_Exit_Stmt - | ON_Next_Stmt => - Loop_Id : O_Snode; - when ON_Case_Stmt => - Selector : O_Enode; - -- Simply linked list of branches - Branches : O_Snode; - Case_Last : O_Snode; - when ON_When_Stmt => - -- The corresponding 'case' - Branch_Parent : O_Snode; - Choice_List : O_Choice; - Next_Branch : O_Snode; - when ON_Call_Stmt => - Proc : O_Dnode; - Assoc : O_Anode; - when ON_Debug_Line_Stmt => - Line : Natural; - when ON_Debug_Comment_Stmt => - Comment : Str_Acc; - end case; - end record; - - type O_Inter_List is record - Func : O_Dnode; - Last : O_Dnode; - end record; - - type O_Element_List is record - -- The type definition. - Res : O_Tnode; - -- The last element added. - Last : O_Fnode; - end record; - - type O_Record_Aggr_List is record - Res : O_Cnode; - Last : O_Cnode; - Field : O_Fnode; - end record; - - type O_Array_Aggr_List is record - Res : O_Cnode; - Last : O_Cnode; - El_Type : O_Tnode; - end record; - - type O_Assoc_List is record - Subprg : O_Dnode; - Interfaces : O_Dnode; - First, Last : O_Anode; - end record; - - type O_Enum_List is record - -- The type built. - Res : O_Tnode; - - -- the chain of declarations. - Last : O_Cnode; - end record; - type O_Case_Block is record - Case_Stmt : O_Snode; - end record; - - type O_If_Block is record - null; - end record; -end Ortho_Debug; diff --git a/ortho/debug/ortho_debug_front.ads b/ortho/debug/ortho_debug_front.ads deleted file mode 100644 index 17e32c9ed..000000000 --- a/ortho/debug/ortho_debug_front.ads +++ /dev/null @@ -1,20 +0,0 @@ --- Ortho debug interface with front-end. --- Copyright (C) 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GCC; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Ortho_Front; -package Ortho_Debug_Front renames Ortho_Front; diff --git a/ortho/debug/ortho_ident.ads b/ortho/debug/ortho_ident.ads deleted file mode 100644 index 46aa8854d..000000000 --- a/ortho/debug/ortho_ident.ads +++ /dev/null @@ -1,20 +0,0 @@ --- Ortho debug back-end interface with identifiers package. --- Copyright (C) 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GCC; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Ortho_Ident_Simple; -package Ortho_Ident renames Ortho_Ident_Simple; diff --git a/ortho/debug/ortho_ident_hash.adb b/ortho/debug/ortho_ident_hash.adb deleted file mode 100644 index 60ab89586..000000000 --- a/ortho/debug/ortho_ident_hash.adb +++ /dev/null @@ -1,72 +0,0 @@ --- Ortho debug hashed identifiers implementation. --- Copyright (C) 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GCC; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -package body Ortho_Ident_Hash is - type O_Ident_Array is array (Hash_Type range <>) of O_Ident; - Hash_Max : constant Hash_Type := 511; - Symtable : O_Ident_Array (0 .. Hash_Max - 1) := (others => null); - - function Get_Identifier (Str : String) return O_Ident - is - Hash : Hash_Type; - Ent : Hash_Type; - Res : O_Ident; - begin - -- 1. Compute Hash. - Hash := 0; - for I in Str'Range loop - Hash := Hash * 31 + Character'Pos (Str (I)); - end loop; - - -- 2. Search. - Ent := Hash mod Hash_Max; - Res := Symtable (Ent); - while Res /= null loop - if Res.Hash = Hash and then Res.Ident.all = Str then - return Res; - end if; - Res := Res.Next; - end loop; - - -- Not found: add. - Res := new Ident_Type'(Hash => Hash, - Ident => new String'(Str), - Next => Symtable (Ent)); - Symtable (Ent) := Res; - return Res; - end Get_Identifier; - - function Get_String (Id : O_Ident) return String is - begin - if Id = null then - return "?ANON?"; - else - return Id.Ident.all; - end if; - end Get_String; - - function Is_Nul (Id : O_Ident) return Boolean is - begin - return Id = null; - end Is_Nul; - - function Is_Equal (Id : O_Ident; Str : String) return Boolean is - begin - return Id.Ident.all = Str; - end Is_Equal; -end Ortho_Ident_Hash; diff --git a/ortho/debug/ortho_ident_hash.ads b/ortho/debug/ortho_ident_hash.ads deleted file mode 100644 index a6e4a56cc..000000000 --- a/ortho/debug/ortho_ident_hash.ads +++ /dev/null @@ -1,46 +0,0 @@ --- Ortho debug hashed identifiers implementation. --- Copyright (C) 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GCC; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -package Ortho_Ident_Hash is - type O_Ident is private; - O_Ident_Nul : constant O_Ident; - - function Get_Identifier (Str : String) return O_Ident; - function Get_String (Id : O_Ident) return String; - function Is_Equal (L, R : O_Ident) return Boolean renames "="; - function Is_Equal (Id : O_Ident; Str : String) return Boolean; - function Is_Nul (Id : O_Ident) return Boolean; -private - type Hash_Type is mod 2**32; - - type String_Acc is access constant String; - - -- Symbol table. - type Ident_Type; - type O_Ident is access Ident_Type; - type Ident_type is record - -- The hash for the symbol. - Hash : Hash_Type; - -- Identification of the symbol. - Ident : String_Acc; - -- Next symbol with the same collision. - Next : O_Ident; - end record; - - O_Ident_Nul : constant O_Ident := null; -end Ortho_Ident_Hash; diff --git a/ortho/debug/ortho_ident_simple.adb b/ortho/debug/ortho_ident_simple.adb deleted file mode 100644 index 83b9756f8..000000000 --- a/ortho/debug/ortho_ident_simple.adb +++ /dev/null @@ -1,44 +0,0 @@ --- Ortho debug identifiers simple implementation. --- Copyright (C) 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GCC; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -package body Ortho_Ident_Simple is - function Get_Identifier (Str : String) return O_Ident - is - begin - return new String'(Str); - end Get_Identifier; - - function Get_String (Id : O_Ident) return String is - begin - if Id = null then - return "?ANON?"; - else - return Id.all; - end if; - end Get_String; - - function Is_Nul (Id : O_Ident) return Boolean is - begin - return Id = null; - end Is_Nul; - - function Is_Equal (Id : O_Ident; Str : String) return Boolean is - begin - return Id.all = Str; - end Is_Equal; -end Ortho_Ident_Simple; diff --git a/ortho/debug/ortho_ident_simple.ads b/ortho/debug/ortho_ident_simple.ads deleted file mode 100644 index f94fe1938..000000000 --- a/ortho/debug/ortho_ident_simple.ads +++ /dev/null @@ -1,31 +0,0 @@ --- Ortho debug identifiers simple implementation. --- Copyright (C) 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GCC; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -package Ortho_Ident_Simple is - type O_Ident is private; - O_Ident_Nul : constant O_Ident; - - function Get_Identifier (Str : String) return O_Ident; - function Get_String (Id : O_Ident) return String; - function Is_Equal (L, R : O_Ident) return Boolean renames "="; - function Is_Equal (Id : O_Ident; Str : String) return Boolean; - function Is_Nul (Id : O_Ident) return Boolean; -private - type O_Ident is access String; - O_Ident_Nul : constant O_Ident := null; -end Ortho_Ident_Simple; diff --git a/ortho/debug/ortho_nodes.ads b/ortho/debug/ortho_nodes.ads deleted file mode 100644 index 8ade66722..000000000 --- a/ortho/debug/ortho_nodes.ads +++ /dev/null @@ -1,21 +0,0 @@ --- Ortho debug back-end interface with front-end. --- Copyright (C) 2005 Tristan Gingold --- --- GHDL 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 2, or (at your option) any later --- version. --- --- GHDL 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 GCC; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Ortho_Debug; - -package Ortho_Nodes renames Ortho_Debug; diff --git a/ortho/gcc/Makefile b/ortho/gcc/Makefile deleted file mode 100644 index 5aafb31c7..000000000 --- a/ortho/gcc/Makefile +++ /dev/null @@ -1,86 +0,0 @@ -ortho_srcdir=.. -orthobe_srcdir=$(ortho_srcdir)/gcc -agcc_objdir=. -agcc_srcdir=$(ortho_srcdir)/gcc -SED=sed -BE=gcc -GNATMAKE=gnatmake -CC=gcc -CXX=g++ -COMPILER=$(CXX) -LINKER=$(CXX) - -# Modify AGCC_GCCSRC_DIR and AGCC_GCCOBJ_DIR for your environment -AGCC_GCCSRC_DIR:=$(HOME)/Projects/gcc4.9.2/source/gcc-4.9.2/ -AGCC_GCCOBJ_DIR:=$(HOME)/Projects/gcc4.9.2/build/ - -# Supplied by main GCC Makefile, copied here for compatibility with same -GMPLIBS = -L$(AGCC_GCCOBJ_DIR)./gmp/.libs -L$(AGCC_GCCOBJ_DIR)./mpfr/.libs \ - -L$(AGCC_GCCOBJ_DIR)./mpc/src/.libs -lmpc -lmpfr -lgmp -GMPINC = -I$(AGCC_GCCOBJ_DIR)./gmp -I$(AGCC_GCCSRC_DIR)/gmp \ - -I$(AGCC_GCCOBJ_DIR)./mpfr -I$(AGCC_GCCSRC_DIR)/mpfr \ - -I$(AGCC_GCCSRC_DIR)/mpc/src - -HOST_LIBS = -ZLIB=-lz - -# Override variables in Makefile.conf for your environment --include $(orthobe_srcdir)/Makefile.conf - -all: $(ortho_exec) - -ORTHO_BASENAME=ortho_gcc -include $(ortho_srcdir)/Makefile.inc - -AGCC_INC_FLAGS=-I$(AGCC_GCCOBJ_DIR)/gcc -I$(AGCC_GCCSRC_DIR)/include \ - -I$(AGCC_GCCSRC_DIR)/gcc -I$(AGCC_GCCSRC_DIR)/gcc/config \ - -I$(AGCC_GCCSRC_DIR)/libcpp/include $(GMPINC) -AGCC_CFLAGS=-g -Wall -DIN_GCC $(AGCC_INC_FLAGS) - -ortho-lang.o: $(agcc_srcdir)/ortho-lang.c \ - $(AGCC_GCCOBJ_DIR)gcc/gtype-vhdl.h \ - $(AGCC_GCCOBJ_DIR)gcc/gt-vhdl-ortho-lang.h - $(COMPILER) -c -o $@ $< $(AGCC_CFLAGS) $(INCLUDES) - -AGCC_LOCAL_OBJS=ortho-lang.o - -AGCC_DEPS := $(AGCC_LOCAL_OBJS) -AGCC_OBJS := $(AGCC_LOCAL_OBJS) \ - $(AGCC_GCCOBJ_DIR)gcc/attribs.o \ - $(AGCC_GCCOBJ_DIR)libcpp/libcpp.a \ - $(AGCC_GCCOBJ_DIR)libiberty/libiberty.a - -LIBBACKTRACE = $(AGCC_GCCOBJ_DIR)/libbacktrace/.libs/libbacktrace.a -LIBDECNUMBER = $(AGCC_GCCOBJ_DIR)/libdecnumber/libdecnumber.a -LIBIBERTY = $(AGCC_GCCOBJ_DIR)/libiberty/libiberty.a -CPPLIB= # Not needed for GHDL - -BACKEND = $(AGCC_GCCOBJ_DIR)/gcc/libbackend.a \ - $(AGCC_GCCOBJ_DIR)/gcc/libcommon-target.a - -BACKENDLIBS = $(CLOOGLIBS) $(GMPLIBS) $(PLUGINLIBS) $(HOST_LIBS) \ - $(ZLIB) -LIBS = $(AGCC_GCCOBJ_DIR)/gcc/libcommon.a \ - $(CPPLIB) $(LIBINTL) $(LIBICONV) $(LIBBACKTRACE) \ - $(LIBIBERTY) $(LIBDECNUMBER) $(HOST_LIBS) - -$(ortho_exec): $(AGCC_DEPS) $(orthobe_srcdir)/ortho_gcc.ads force - $(GNATMAKE) -m -o $@ -g -aI$(ortho_srcdir) \ - -aI$(ortho_srcdir)/gcc $(GNAT_FLAGS) ortho_gcc-main \ - -bargs -E -largs --LINK=$(LINKER) $(AGCC_OBJS) \ - $(BACKEND) $(LIBS) $(BACKENDLIBS) - -agcc-clean: force - $(RM) -f $(agcc_objdir)/*.o - $(RM) -f $(agcc_srcdir)/*~ - -clean: agcc-clean - $(RM) -f *.o *.ali ortho_nodes-main - $(RM) b~*.ad? *~ - -distclean: clean agcc-clean - - -force: - -.PHONY: force all clean agcc-clean diff --git a/ortho/gcc/Makefile.conf.linux b/ortho/gcc/Makefile.conf.linux deleted file mode 100644 index 00ea91728..000000000 --- a/ortho/gcc/Makefile.conf.linux +++ /dev/null @@ -1,4 +0,0 @@ -# Example Makefile.conf -# Copy this file to Makefile.conf and edit as necessary for your platform - -HOST_LIBS = -ldl -lstdc++ diff --git a/ortho/gcc/lang.opt b/ortho/gcc/lang.opt deleted file mode 100644 index 562fbe08d..000000000 --- a/ortho/gcc/lang.opt +++ /dev/null @@ -1,96 +0,0 @@ -Language -vhdl - --std= -vhdl Joined -Select the vhdl standard - --compile-standard -vhdl -Used during compiler build to compile the std.standard package - --bootstrap -vhdl -Used during compiler build to compile std packages - --work= -vhdl Joined -Set the name of the work library - --workdir= -vhdl Joined -Set the directory of the work library - -P -vhdl JoinedOrMissing -;-P Add to the end of the vhdl library path - --elab -vhdl Separate ---elab Used internally during elaboration of - --anaelab -vhdl Separate ---anaelab Used internally during elaboration of - -; -c is a driver option for gcc. --ghdl-source is used instead. -;c -;vhdl Separate -;-c Analyze for --anaelab - -;v -;vhdl -;Verbose - --warn- -vhdl Joined ---warn- Warn about - --ghdl -vhdl Joined ---ghdl-